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 / HIRES4.I < prev    next >
Text File  |  1979-12-31  |  11KB  |  355 lines
  1. { Inline machine-code version of HiRes and HiDot
  2.   with comments/mnemonics (See Hires5a.i .... Hires5c.i)
  3.   Written by Daniel Prager 1986 }
  4.  
  5. {This code is an adaption of the HiDot function created by Daniel Prager 1986
  6.   to use the full Premium Graphics in Hires mode
  7.   modification by R.K.Hallworth, Donvale Christian School, April 1987}
  8.  
  9. { The video driver ( procedure VDUOUT ) allows a complete mix of underline
  10.    (turn on with ESC '['  turn off with  ESC ']' )
  11.   and highlighting
  12.    (turn on with ESC ')'  turn off with  ESC '(' )
  13.  
  14. see Hires4.pas for an sample of use }
  15.  
  16. Type
  17.    PCGs=Array [0..15] of byte;
  18.  
  19. Var   ConOutAdr,CursPos :integer; {store location of bios VDU driver}
  20.       VDUstatus         :array [1..6] of byte;{ESC,CURSPOS,LINE,UNDERLINE,INVERSE,EOL}
  21.       Scratch : PCGs;  {Scratch for desired PCG}
  22.       VideoWidth:Integer;
  23. Const
  24.       UsedPCGs=0;
  25.  
  26. procedure StorePCG(Ch:Char);
  27.  
  28. begin
  29.  
  30. inline($3E/ $01/$D3/$0B/$3A/CH/$6F/$26/0/$29/$29/$29/$29/
  31.        $11/$F000/$19/$11/SCRATCH/$01/16/0/$ED/$B0/$AF/
  32.        $D3/ $0B)
  33. end;
  34.  
  35.  
  36. Procedure ClearHiRes;
  37.  
  38. Var RAMBank,PCGByte:integer;
  39.  
  40. Begin
  41.          VDUstatus[1]:=0;
  42.          VDUstatus[2]:=0;
  43.          VDUstatus[6]:=0;
  44.          port[28]:=144;
  45.          For PCGByte:=0 to $7FF do Mem[$F000+PCGByte]:=0;
  46.          port[28]:=128;
  47.          For PCGByte:=0 to $7FF do Mem[$F000+PCGByte]:=32
  48. end;
  49.  
  50.  
  51.  
  52. Procedure VduOut(Ch:Char);
  53.  
  54. Type
  55.    PCGs=Array [0..15] of byte;
  56.  
  57.  
  58. Var Bt,count,PCGNo,PCGBank:byte;
  59.     PCGPos:Integer;
  60.     Scratch : PCGs;  {Scratch for desired PCG}
  61.     Lines:Byte;
  62.  
  63. Const
  64.       TickArray:PCGs=(0,2,4,4,4,8,8,$48,$30,$10,0,0,0,0,0,0);
  65.  
  66. procedure StorePCG(Ch:Char);
  67.  
  68. begin
  69.  
  70. inline($3E/ $01/$D3/$0B/$3A/CH/$6F/$26/0/$29/$29/$29/$29/
  71.        $11/$F000/$19/$11/SCRATCH/$01/16/0/$ED/$B0/$AF/
  72.        $D3/ $0B)
  73. end;
  74.  
  75. Procedure Invert;
  76.  
  77. begin
  78.   inline($06/16/$21/SCRATCH/$7E/$2F/$77/$23/$10/$FA)
  79. end;
  80.  
  81.  
  82. Procedure ScrollUp(Width:Integer);
  83.  
  84. Var LineWidth:Integer;
  85.  
  86. begin
  87.    LineWidth:=Width;
  88.    inline($18/14/$11/$F000/$2A/linewidth/$26/$F0/$01/1000/$ED/$B0/
  89.           $C9/$3E/$00/$D3/$0B/$CD/*-19/$3E/144/$D3/28/
  90.           $CD/*-26/$3E/128/$D3/28)
  91. end;
  92.  
  93. Procedure SaveScratch;
  94. begin
  95.    PCGBank:= (CursPos-$F000) shr 7;
  96.    PCGNo  := (CursPos-$F000) and $7F;
  97.    Port[28]:=144;
  98.    Mem[CursPos]:=PCGBank;
  99.    Port[28]:=128+PCGBank;
  100.    PCGPos:=(PCGNo shl 4)+$F800;
  101.    Move(Scratch,Mem[PCGPos],16);
  102.    Port[28]:=128;
  103.    Mem[CursPos]:=PCGNo+128
  104. end;
  105.  
  106. begin
  107.  
  108. Inline($F3/$F5/$C5/$D5/$E5/$DD/$E5/$FD/$E5); {SAVE REGISTERS ON STACK}
  109.  
  110.   if VduStatus[1]<>1 then
  111.      begin
  112.        Case Ch of
  113.         ' '..'}' :begin
  114.                         CursPos:=CursPos+1;
  115.                         If hi(CursPos)>=$F8 then CursPos:=$F7FF;
  116.                         If (VduStatus[4]=1) or (VduStatus[5]=1)
  117.                            then
  118.                                begin
  119.                                   StorePCG(Ch);
  120.                                   If VduStatus[4]=1 then
  121.                                   begin
  122.                                      if VideoWidth=64
  123.                                          then Scratch[13]:=255 {underline}
  124.                                          else Scratch[9] :=255 {underline}
  125.                                   end;
  126.                                   if VDUstatus[5]=1 then invert;
  127.                                   SaveScratch;
  128.                                 end
  129.                             else
  130.                                 begin
  131.                                   Port[28]:=144;
  132.                                   Mem[CursPos]:=0;
  133.                                   Port[28]:=128;
  134.                                   Mem[CursPos]:=Ord(Ch)
  135.                                 end;
  136.                         Port[28]:=128;
  137.                       end;
  138.          #13     :Begin
  139.                      If VduStatus[6]=1 then CursPos:=Pred(CursPos);
  140.                      CursPos:=(((CursPos+1) - $F000) div VideoWidth)*VideoWidth + $EFFF;
  141.                      VduStatus[6]:=2;
  142.                   end;
  143.          #10     :Begin
  144.                      If VduStatus[6]=0 then VDUStatus[6]:=2;
  145.                      CursPos:=CursPos+VideoWidth;
  146.                   end;
  147.          #8,#127 :begin
  148.                     If CursPos>=$F000 then
  149.                     begin
  150.                        Port[28]:=144;
  151.                        Mem[CursPos]:=0;
  152.                        Port[28]:=128;
  153.                        Mem[CursPos]:=32;
  154.                        CursPos:=CursPos-1
  155.                     end;
  156.                   end;
  157.           #128    :begin
  158.                     CursPos:=Succ(CursPos);
  159.                     Scratch:=TickArray;
  160.                     SaveScratch;
  161.                   end;
  162.          ^G      :Begin
  163.                       ConOutPtr:=ConOutAdr;
  164.                       Write(^G); {Beep}
  165.                       ConOutPtr:=Addr(VduOut);
  166.                   end;
  167.          ^Z      :begin
  168.                      CursPos:=$F000-1;
  169.                      ClearHiRes
  170.                   end;
  171.          #27     :VDUstatus[1]:=1 {esc}
  172.        end;
  173.  
  174.      end
  175.     else
  176.         Case VDUstatus[2] of
  177.              1:begin
  178.                  VDUstatus[3]:=(Ord(Ch)-32) and $1f;
  179.                  VDUstatus[2]:=2;
  180.                 end;
  181.               2:begin
  182.                   CursPos:=$F000-1+(VDUstatus[3]*VideoWidth)+((Ord(Ch)-32) and 63);
  183.                   For Count:= 1 to 3 do VDUstatus[count]:=0
  184.                  end
  185.            else
  186.                begin
  187.                  Case Ch of
  188.  
  189.                     '='   :VDUstatus[2]:=1;
  190.                     '['   :VduStatus[4]:=1;{UNDERLINE ON}
  191.                     ']'   :VduStatus[4]:=0;
  192.                     ')'   :VduStatus[5]:=1;{Highlight on}
  193.                     '('   :VduStatus[5]:=0;
  194.  
  195.                   end;
  196.                   If VduStatus[2]=0 then VDUstatus[1]:=0
  197.                 end
  198.             end;
  199.   If VideoWidth=40 then lines:=24
  200.                    else lines:=16;
  201.   If CursPos>=$F000+VideoWidth*Lines
  202.      then begin
  203.          CursPos:=Curspos-VideoWidth;
  204.          ScrollUp(VideoWidth);
  205.      end;
  206.   If VDUStatus[6]=2
  207.      then  VDUStatus[6]:=0 {Cr sent (Start of new line)}
  208.      else  VDUStatus[6]:=1;{Cr not sent at EOL}
  209.  
  210. Inline($FD/$E1/$DD/$E1/$E1/$D1/$C1/$F1/$FB); {RESTORE REGISTERS FROM STACK}
  211.  
  212. end;
  213.  
  214.  
  215.  
  216.  
  217.  
  218. function HiDot (A, B, F : Integer) : Boolean;
  219.  
  220. {Modified by R.K.Hallworth of Donvale Christian School for the
  221.  Premium using 64x16 screen
  222.  Function to alter a pixel anywhere on the screen.  Returns TRUE if
  223.  successful and FALSE if there is an illegal parameter or if all PCGs have
  224.  been used.  HiRes must be called prior to the first call to HiDot }
  225.  
  226. var
  227.   Scratch : array [0..15] of Byte;  {Scratch for desired PCG}
  228.   Temp,Bank,                             {Temporary storage}
  229.   Memory,
  230.   Video   : Integer;                {Address in screen RAM of PCG to be
  231.                                      changed}
  232.   X,Y     :Integer;
  233.   PCGAddr :Integer;                  {address of PCG}
  234.   Line,                             {Line of PCG to be changed}
  235.   PCG,PCGByte,                      {PCG at Mem[Video]}
  236.   Mask    : Byte;                   {Mask to be applied to Scratch[Line]
  237.                                      to alter the correct dot}
  238.   H       : Boolean;                {Result of HiDot}
  239. Type
  240.   MaskArray=array[0..7] of byte;
  241. const
  242.   Masks:MaskArray=(1,2,4,8,16,32,64,128);
  243.  
  244. begin
  245.   X:=A;
  246.   Y:=B;
  247.          {DI}
  248.   Inline($F3/$F5/$C5/$D5/$E5/$DD/$E5/$FD/$E5); {SAVE REGISTERS ON STACK}
  249.  
  250.   Inline($A7/$ED/$5B/X/$21/511/$ED/$52/$DA/*+25/$ED/$5B/Y/$21/>255/
  251.          $ED/$52/$DA/*+13/$3A/F/$D6/3/$D2/*+5/$C3/*+6/$97/$C3/*+237/
  252.          $2A/X/$7D/$0E/7/$A1/$A9/$E5/$5F/$16/0/$21/MASKS/$19/$7E/$E1/
  253.          $32/Mask/$06/$03/$CB/$3D/$CB/$3C/$D2/*+4/$CB/$FD/$10/$F5/$E5/
  254.          $2A/Y/$3E/15/$A5/$67/$3E/15/$94/$32/Line/$2A/Y/$7D/$16/240/$A2/
  255.          $AA/$6F/$06/0/$29/$29/$D1/$19/$E5/$11/$F000/$19/$22/Video/$97/
  256.          $D3/11/$7E/$32/PCG/$6F/$D6/127/$FA/*+21/$F1/$CB/$BD/$E5/$3E/144/
  257.          $D3/28/$2A/VIDEO/$7E/$C6/$80/$D3/$1C/$C3/*+39/$D1/$D5/$CB/$22/
  258.          $CB/$7B/$CA/*+4/$CB/$C2/$3E/144/$D3/28/$2A/VIDEO/$7A/$77/$C6/$80/
  259.          $D3/$1C/$E1/$7D/$E6/127/$6F/$E5/$7D/$C6/128/$2A/Video/$77/$E1/
  260.          $26/0/$29/$29/$29/$29/$11/$F800/$19/$22/PCGAddr/$3A/PCG/$6F/
  261.          $60/$D6/127/$F2/*+22/$3E/1/$D3/11/$29/$29/$29/$29/$11/$F000/$19/
  262.          $ED/$5B/PCGAddr/$0E/16/$ED/$B0/$97/$D3/11/$2A/PCGAddr/$ED/$5B/Line/
  263.          $16/0/$19/$46/$3A/Mask/$4F/$3A/F/$FE/0/$CA/*+12/$FE/1/$CA/*+13/
  264.          $78/$A9/$C3/*+14/$79/$2F/$A0/$C3/*+4/$78/$B1/$B8/$CA/*+3/$77/
  265.          $3E/1/$32/H/$3E/128/$D3/28);
  266.                                              {EI}
  267.       Inline($FD/$E1/$DD/$E1/$E1/$D1/$C1/$F1/$FB); {RESTORE REGISTERS FROM STACK}
  268.  
  269.       HiDot := H
  270. end;
  271.  
  272. Procedure SetVideo(Width:integer);
  273.  
  274. Var Count:byte;
  275.  
  276. procedure NORMAL;
  277.  
  278. { Procedure to restore Inverse characters
  279.              to the PCG.
  280.  
  281.   This procedure is derived from the disk
  282.   ROM routine at  E02AH,  which fills the
  283.   PCG  with  inverse  characters  of  the
  284.   current font type.
  285. }
  286.  
  287. begin { procedure normal }
  288.      inline($3E/$01/$D3/$0B/$21/$F000/$11/$F800/$7E/$2F/$12/
  289.             $23/$13/$CB/$5C/$28/$F7/$AF/$D3/$0B)
  290. end; {procedure normal}
  291.  
  292. Procedure vdu_init;
  293.  
  294. begin
  295.  
  296.   Inline($3E/0/$Db/9); {RESET VIDEO CLOCK SPEED}
  297.  
  298.   inline ($21/*+52/$C5/$E5/6/$10/$78/$3D/$D3/$0C/$7E/$D3/
  299.           $0D/$2B/$10/$F6/6/$4B/$CD/*+5/$E1/$C1/$C9/
  300.           $E5/$21/$7A/0/$2B/$7C/$B5/$20/$FB/$10/$F6/$E1/$C9/
  301.  
  302.           {Crtc Initialisation data for 80x24 screen}
  303.   {Data=>}$6b/$50/$58/$37/$1b/$05/$18/$1a/$48/$0a/$2a/$0a/$20/$00/$00/$00);
  304.  
  305.  
  306. end;
  307.  
  308.  
  309.  
  310. begin  {Set Video}
  311.   ClrScr;
  312.   CursPos:=$F000-1;
  313.   VideoWidth:=Width;
  314.   ConOutPtr:=Addr(VduOut); {Set to internal Vdu Driver}
  315.   For count:=1 to 6 do VDUstatus[count]:=0;
  316.   Case VideoWidth of
  317.   40:begin
  318.        Inline($3E/1/$DB/9);{HALVES VIDEO CLOCK SPEED}
  319.  
  320.         inline ($21/*+52/$C5/$E5/6/$10/$78/$3D/$D3/$0C/$7E/$D3/
  321.                $0D/$2B/$10/$F6/6/$4B/$CD/*+5/$E1/$C1/$C9/
  322.                $E5/$21/$7A/0/$2B/$7C/$B5/$20/$FB/$10/$F6/$E1/$C9/
  323.  
  324.                {Crtc Initialisation data for 40x24 screen}
  325.          {Data=>}$35/$28/$2D/$24/$1b/$05/$19/$1a/$48/$0a/$2a/$0a/$20/$00/$00/$00);
  326.          {Normal;}
  327.       end;
  328.   64:begin
  329.       Inline($3E/0/$Db/9); {RESET VIDEO CLOCK SPEED}
  330.       inline ($21/*+52/$C5/$E5/6/$10/$78/$3D/$D3/$0C/$7E/$D3/
  331.           $0D/$2B/$10/$F6/6/$4B/$CD/*+5/$E1/$C1/$C9/
  332.           $E5/$21/$7A/0/$2B/$7C/$B5/$20/$FB/$10/$F6/$E1/$C9/
  333.           107/64/81/55/18/9/$10/17/$48/$0F/$2F/$0F/
  334.           0/0/0/0)  {64*16}
  335.      end;
  336.   80:begin
  337.        Vdu_init; {80*24 screen}
  338.        ConOutPtr:=ConOutAdr; {Set to standard video driver}
  339.        ClearHiRes;
  340.        normal; {Sets normal inverse characters}
  341.      end;
  342.   end;
  343.   ClrScr;
  344. end;
  345.  
  346. Procedure Hires;
  347. begin
  348.   SetVideo(64);
  349. end;
  350.  
  351. Procedure SaveStandardVideoAddr;
  352. begin
  353.   ConOutAdr:=ConOutPtr;
  354. end;
  355.