home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / XGRAPH.ZIP / SMPLXGRF.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-03-22  |  29.9 KB  |  911 lines
  1. program SampleExtendedGraphics;
  2. {
  3.   Program to demostrate the use of the XGRAPH routines.
  4.  
  5.   Written by Abe Achkinazi on March 12, 1987.
  6. }
  7.  
  8. {$I Xgraph.pas}
  9.  
  10. type
  11.  
  12.   CharPtrType = ^Byte;
  13.  
  14.   MaxString = string[255];  
  15.  
  16.   StringPtr = ^StringListType;
  17.   StringListType = record
  18.                      StrPtr : StringPtr;
  19.                      Line : MaxString;
  20.                    end;
  21.  
  22. const
  23.   AllBlack:array[0..15] of integer=($00,$00,$00,$00,$00,$00,$00,$00,
  24.                                     $00,$00,$00,$00,$00,$00,$00,$00 );
  25. var { Globals }
  26.   GrfData : GraphicsData;
  27.   Regs : VidRegs;
  28.   Done : boolean;
  29.   Input1, Input2, Output1, Output2 : integer;
  30.   FontWidth, FontHeight : integer;
  31.   Top : StringPtr;
  32.   Selection : integer;
  33.   c : char;
  34.  
  35.  
  36. { Utility functions }
  37. { ----------------- }
  38. function GetNum(Strng:VidStringType; var Position, Value:integer):boolean;
  39. {
  40.   Given a string and a position in the string, extract the next integer
  41.   in the string skipping any characters between the given position and the
  42.   number.
  43. }
  44. var first,last : integer;
  45.     NumFound : boolean;
  46.     Code : integer;
  47.     StrCopy : VidStringType;
  48. begin
  49.   first := Position;
  50.   NumFound := false;
  51.   while (first <= Length(Strng)) and not(Strng[first] in ['-', '0'..'9']) do
  52.     first := first+1;
  53.   if first <= Length(Strng) then begin
  54.     NumFound := true; last:=first;
  55.     while ((last+1) <= Length(Strng)) and (Strng[last+1] in ['0'..'9']) do
  56.       last := last+1;
  57.   end;
  58.   if NumFound then begin
  59.     StrCopy := Copy(Strng,First,(Last-First)+1);
  60.     Val(StrCopy,Value,Code);
  61.     GetNum := NumFound and (Code = 0); Position := Last+1;
  62.   end
  63.   else begin GetNum := false; Position := Length(Strng)+1 end;
  64. end; { of GetNum }
  65.  
  66. procedure AddString(var Top : StringPtr; StringX : MaxString);
  67. {
  68.   Adds a string at the end of the chain.
  69. }
  70. var TempStr : StringPtr;
  71. begin
  72.   if Top=Nil then begin
  73.     new(Top);
  74.     Top^.StrPtr:=Nil;
  75.     Top^.Line:=StringX
  76.   end
  77.   else begin
  78.     TempStr:=Top;
  79.     while TempStr^.StrPtr<>Nil do TempStr:=TempStr^.StrPtr;
  80.     new(TempStr^.StrPtr); TempStr:=TempStr^.StrPtr;
  81.     TempStr^.StrPtr:=Nil; TempStr^.Line:=StringX;
  82.   end;
  83. end; { of AddString }
  84.  
  85. procedure PaintScreen;
  86. {
  87.   Clears graphic screen and draws bounding lines.
  88. }
  89. var LocalRegs: VidRegs;
  90. begin with LocalRegs, GrfData do begin
  91.   ax := VidClear shl 8;
  92.   Intr(VideoInt, LocalRegs);
  93.  
  94.   ax:=VidLine shl 8 + $78;
  95.   cx:=MinX; dx:=Input2+FontHeight; { Top Line }
  96.   si:=MaxX; di:=dx;
  97.   Intr(VideoInt, LocalRegs);
  98.   cx:=si; dx:=di;                  { Right Line }
  99.   si:=si; di:=Output1-1;
  100.   Intr(VideoInt, LocalRegs);
  101.   cx:=si; dx:=di;                  { Bottom Line }
  102.   si:=MinX; di:=di;
  103.   Intr(VideoInt, LocalRegs);
  104.   cx:=si; dx:=di;                  { Left Line }
  105.   si:=MinX; di:=Input2+FontHeight;
  106.   Intr(VideoInt, LocalRegs);
  107. end end; { of PaintScreen }
  108.  
  109. procedure ClearInput;
  110. {
  111.   Clear command input area.
  112. }
  113. var LocalRegs : VidRegs;
  114. begin with LocalRegs do begin
  115.   ax := VidRectFill shl 8 + $0F;
  116.   cx := GrfData.MinX; dx:=Input1;
  117.   si := GrfData.MaxX; di:=Input2+FontHeight-1;
  118.   es:=seg(AllBlack); bx:=ofs(AllBlack);
  119.   Intr(VideoInt, LocalRegs);
  120. end end;
  121.  
  122.  
  123. Procedure DoChoice( Selections:StringPtr; Que1, Que2:MaxString;
  124.                     Numbered:boolean; x, y:integer; var Select:integer);
  125. {
  126.   Procedure to take a list of choices display them on the screen and
  127.   get a selection from the user. The information behind the formed menu
  128.   is saved and restored after the user has selected a choice.
  129. }
  130. var
  131.   MaxHeight, MaxWidth, RectArea, i: integer;
  132.   LineNumber : integer;
  133.   TempPtr: StringPtr;
  134.   TempStr : MaxString;
  135.   IOString: VidStringType;
  136.   Code : integer;
  137.   SaveAreaLoc : ^byte;
  138.   SaveAreaDesc : Raster;
  139.   TopOfHeap : ^byte;
  140.   LocalBlitParms : BlitParm;
  141.   LocalRegs : VidRegs;
  142.   Localy : integer;
  143. begin
  144.   { Write queue lines }
  145.   ClearInput;
  146.   WriteStr(Que1,0,Input1,GrfData); WriteStr(Que2,0,Input2,GrfData);
  147.  
  148.  
  149.   { Find Number of strings and widest One }
  150.   MaxWidth := 0; MaxHeight:=2; TempPtr:=Selections;
  151.   while TempPtr <> Nil do begin
  152.     MaxHeight:=MaxHeight+1;
  153.     if length(TempPtr^.Line)>MaxWidth then MaxWidth:=length(TempPtr^.Line);
  154.     TempPtr := TempPtr^.StrPtr;
  155.   end;
  156.   MaxWidth:=MaxWidth+2;
  157.  
  158.   if Numbered then MaxWidth:=MaxWidth+4;
  159.  
  160.   { Save area about to be overwritten by menu }
  161.   RectArea := FontHeight*MaxHeight*MaxWidth;
  162.   Mark(TopOfHeap);
  163.   GetMem(SaveAreaLoc,RectArea);
  164.   with SaveAreaDesc do begin
  165.     Offset:=ofs(SaveAreaLoc^); Segment:=seg(SaveAreaLoc^);
  166.     Width:=MaxWidth;
  167.     OrigenX:=0; OrigenY:=0;
  168.     CornerX:=FontWidth*MaxWidth-1; CornerY:=FontHeight*MaxHeight-1;
  169.   end;
  170.   with LocalBlitParms do begin
  171.     DestOffset:=ofs(SaveAreaDesc); DestSegment:=seg(SaveAreaDesc);
  172.     SrcOffset:=ofs(GrfData); SrcSegment:=seg(GrfData);
  173.     RectOrigenX:=0; RectOrigenY:=0;
  174.     RectCornerX:=FontWidth*MaxWidth-1; RectCornerY:=FontHeight*MaxHeight-1;
  175.     PointX:=x; PointY:=y;
  176.     Opcode:=BlitS; TextOp:=TextS;
  177.   end;
  178.   with LocalRegs do begin
  179.     ax:=VidBlit shl 8;
  180.     bx:=$010F;
  181.     ds:=seg(LocalBlitParms); si:=ofs(LocalBlitParms);
  182.     Intr(VideoInt, LocalRegs);
  183.   end;
  184.  
  185.   Localy:=y;
  186.   { Do Top Part }
  187.   TempStr := '┌';
  188.   for i:=1 to MaxWidth-2 do TempStr:=TempStr+'─';
  189.   TempStr := TempStr+'┐';
  190.   WriteStr(TempStr,x,Localy,GrfData); Localy:=Localy+FontHeight;
  191.  
  192.   { Do Midle Part }
  193.   TempPtr:=Selections; LineNumber := 1;
  194.   while TempPtr <> Nil do begin
  195.     if Numbered then begin
  196.       Str(LineNumber:2,TempStr); LineNumber:=LineNumber+1;
  197.       TempStr:='│'+TempStr+') '+TempPtr^.Line;
  198.       for i:=1 to MaxWidth-6-length(TempPtr^.Line) do TempStr:=TempStr+' ';
  199.       TempStr:=TempStr+'│'
  200.     end
  201.     else begin
  202.       TempStr:='│'+TempPtr^.Line;
  203.       for i:=1 to MaxWidth-2-length(TempPtr^.Line) do TempStr:=TempStr+' ';
  204.       TempStr:=TempStr+'│'
  205.     end;
  206.     WriteStr(TempStr,x,Localy,GrfData); Localy:=Localy+FontHeight;
  207.     TempPtr:=TempPtr^.StrPtr;
  208.   end;
  209.  
  210.   { Do Bottom Part }
  211.   TempStr := '└';
  212.   for i:=1 to MaxWidth-2 do TempStr:=TempStr+'─';
  213.   TempStr := TempStr+'┘';
  214.   WriteStr(TempStr,x,Localy,GrfData); Localy:=Localy+FontHeight;
  215.  
  216.   { Get selection here }
  217.   if Que2 = '' then
  218.     ReadStr(IOString,(Length(Que1)+1)*FontWidth,Input1,GrfData)
  219.   else
  220.     ReadStr(IOString,(Length(Que2)+1)*FontWidth,Input2,GrfData);
  221.   Val(IOString,Select,Code);
  222.   if Code <> 0 then Select:=-1;
  223.  
  224.   { Restore area overwritten by menu and return memory }
  225.   with LocalBlitParms do begin
  226.     DestOffset:=ofs(GrfData); DestSegment:=seg(GrfData);
  227.     SrcOffset:=ofs(SaveAreaDesc); SrcSegment:=seg(SaveAreaDesc);
  228.     RectOrigenX:=x; RectOrigenY:=y;
  229.     RectCornerX:=x+FontWidth*MaxWidth-1; RectCornerY:=y+FontHeight*MaxHeight-1;
  230.     PointX:=0; PointY:=0;
  231.     Opcode:=BlitS; TextOp:=TextS;
  232.   end;
  233.   with LocalRegs do begin
  234.     ax:=VidBlit shl 8;
  235.     bx:=$010F;
  236.     ds:=seg(LocalBlitParms); si:=ofs(LocalBlitParms);
  237.     Intr(VideoInt, LocalRegs);
  238.   end;                      
  239.   Release(TopOfHeap);
  240.  
  241. end; { of DoChoice }
  242.  
  243. procedure ClearRegs(var Regs: VidRegs);
  244. begin with Regs do begin
  245.   ax:=0; bx:=0; cx:=0; dx:=0; ds:=0; si:=0; es:=0; di:=0
  246. end end;
  247.  
  248. procedure HexString(i : integer; var HString : VidStringType);
  249. {
  250.   Convert a 16-bit integer into a 4 character Hex string.
  251. }
  252. var x, j : integer;
  253. begin
  254.   HString:='$';
  255.   for j:=1 to 4 do begin
  256.     x:=(i shr ((4-j)*4)) and $000F;
  257.     case x of
  258.        0: HString:=HString+'0';  1: HString:=HString+'1';
  259.        2: HString:=HString+'2';  3: HString:=HString+'3';
  260.        4: HString:=HString+'4';  5: HString:=HString+'5';
  261.        6: HString:=HString+'6';  7: HString:=HString+'7';
  262.        8: HString:=HString+'8';  9: HString:=HString+'9';
  263.       10: HString:=HString+'A'; 11: HString:=HString+'B';
  264.       12: HString:=HString+'C'; 13: HString:=HString+'D';
  265.       14: HString:=HString+'E'; 15: HString:=HString+'F'
  266.     end;
  267.   end;
  268. end;  { of HexString }
  269.  
  270. procedure DisplayRegs(Regs : VidRegs);
  271. {
  272.   Display the contents of the registers passed in the Output data area.
  273. }
  274. var NumString, IOString : VidStringType;
  275. begin with Regs do begin
  276.   HexString(ax, NumString);
  277.   IOString:='AX = '+NumString;
  278.   HexString(bx, NumString);
  279.   IOString:=IOString+'    BX = '+NumString;
  280.   HexString(cx, NumString);
  281.   IOString:=IOString+'    CX = '+NumString;
  282.   HexString(dx, NumString);
  283.   IOString:=IOString+'    DX = '+NumString;
  284.   WriteStr(IOString, 0,Output1, GrfData);
  285.   HexString(ds, NumString);
  286.   IOString:='DS = '+NumString;
  287.   HexString(si, NumString);
  288.   IOString:=IOString+'    SI = '+NumString;
  289.   HexString(es, NumString);
  290.   IOString:=IOString+'    ES = '+NumString;
  291.   HexString(di, NumString);
  292.   IOString:=IOString+'    DI = '+NumString;
  293.   WriteStr(IOString, 0,Output2, GrfData);
  294. end end;
  295.  
  296. procedure ClipToScreenPixel(var x,y:integer);
  297. begin
  298.   if x < (GrfData.MinX+1) then x:=GrfData.MinX+1;
  299.   if x > (GrfData.MaxX-1) then x:=GrfData.MaxX-1;
  300.   if y < Input2+FontHeight+1 then y:=Input2+FontHeight+1;
  301.   if y > Output1-2 then y:=Output1-2;
  302. end;
  303.  
  304. procedure ClipToScreenBit(var x,y:integer);
  305. begin
  306.   if x < (GrfData.MinimumX+1) then x:=GrfData.MinimumX+1;
  307.   if x > (GrfData.MaximumX-1) then x:=GrfData.MaximumX-1;
  308.   if y < Input2+FontHeight+1 then y:=Input2+FontHeight+1;
  309.   if y > Output1-2 then y:=Output1-2;
  310. end;
  311.  
  312. procedure SwapPair(var x,y : integer);
  313. var temp : integer;
  314. begin
  315.   temp:=y; y:=x; x:=y
  316. end;
  317.  
  318. procedure GetPattern(var pat : integer);
  319. {
  320.   Allow the user to select the filling pattern for the current function.
  321. }
  322. var IOString : VidStringType;
  323.     List : StringPtr;      
  324.     TopOfHeap : ^Byte;
  325. begin                                              
  326.   ClearInput; pat:=1;
  327.   Mark(TopOfHeap); List:=Nil;
  328.   AddString(List,'1/2 Grey');             AddString(List,'2/4 Grey');
  329.   AddString(List,'4/8 Grey');             AddString(List,'L/R Diagonals');
  330.   AddString(List,'R/L Diagonals');        AddString(List,'Horizontal Lines');
  331.   AddString(List,'Vertical Lines');       AddString(List,'Brocade 1');
  332.   AddString(List,'Square Weave');         AddString(List,'Brocade 2');
  333.   AddString(List,'Crosses and Naughts '); AddString(List,'Triagular Pattern');
  334.   AddString(List,'Circular Pattern');     AddString(List,'Braides');
  335.   AddString(List,'Fancy Bricks');         AddString(List,'Wizards');
  336.   DoChoice(List,'Select an area pattern (1..16): ', '', true,
  337.             4,Input2+FontHeight+1, pat);
  338.   Release(TopOfHeap); List:=Nil;
  339.   pat:=(pat-1) mod 16;
  340. end; { Of GetPattern }
  341.      
  342. procedure GetPixelCoord(Msg : VidStringType; var x,y : integer;
  343.                         DefaultX, DefaultY:integer);
  344. {
  345.   Get a pixel coordinate from the user and default to given legal value
  346.   if wrong data.
  347. }
  348. var IOString : VidStringType; Position :integer;
  349.     NumStr : VidStringType;
  350. begin              
  351.   ClearInput;
  352.   WriteStr(Msg, 0,Input1, GrfData);
  353.   IOString:='Coordinates must be in the range X in (';
  354.   Str(GrfData.MinX+1,NumStr); IOString:=IOString+NumStr+'..';
  355.   Str(GrfData.MaxX-1,NumStr); IOString:=IOString+NumStr+'), Y in (';
  356.   Str(Input2+FontHeight+1,NumStr); IOString:=IOString+NumStr+'..';
  357.   Str(Output1-2,NumStr); IOString:=IOString+NumStr+').';
  358.   WriteStr(IOString, 0,Input2, GrfData);
  359.   ReadStr(IOString, (Length(Msg)+1)*FontWidth,Input1, GrfData); Position:=1;
  360.   if not(GetNum(IOString,Position,x)) then x:=DefaultX;
  361.   if not(GetNum(IOString,Position,y)) then y:=DefaultY;
  362.   ClipToScreenPixel(x,y);
  363. end; { of GetPixelCoord }
  364.  
  365. procedure GetBitCoord(Msg : VidStringType; var x,y : integer;
  366.                         DefaultX, DefaultY:integer);
  367. {
  368.   Get a bit coordinate from the user and default to given legal value
  369.   if wrong data.
  370. }
  371. var IOString : VidStringType; Position :integer;
  372.     NumStr : VidStringType;
  373. begin              
  374.   ClearInput;
  375.   WriteStr(Msg, 0,Input1, GrfData);
  376.   IOString:='Coordinates must be in the range X in (';
  377.   Str(GrfData.MinimumX+1,NumStr); IOString:=IOString+NumStr+'..';
  378.   Str(GrfData.MaximumX-1,NumStr); IOString:=IOString+NumStr+'), Y in (';
  379.   Str(Input2+FontHeight+1,NumStr); IOString:=IOString+NumStr+'..';
  380.   Str(Output1-2,NumStr); IOString:=IOString+NumStr+').';
  381.   WriteStr(IOString, 0,Input2, GrfData);
  382.   ReadStr(IOString, (Length(Msg)+1)*FontWidth,Input1, GrfData); Position:=1;
  383.   if not(GetNum(IOString,Position,x)) then x:=DefaultX;
  384.   if not(GetNum(IOString,Position,y)) then y:=DefaultY;
  385.   ClipToScreenBit(x,y);
  386. end; { of GetBitCoord }
  387.  
  388. procedure GetLinePattern(var LinePat : integer);
  389. {
  390.   Get Line pattern from the use.
  391. }
  392. var IOString : VidStringType; Position : integer;
  393.     List : StringPtr;
  394.     TopOfHeap : ^Byte;
  395. begin
  396.   ClearInput; LinePat:=1;
  397.   Mark(TopOfHeap); List:=Nil;
  398.   AddString(List,'1111111111111111'); AddString(List,'1100110011001100');
  399.   AddString(List,'1111000011110000'); AddString(List,'0110011111100110');
  400.   AddString(List,'0101010101010101'); AddString(List,'1010101010101010');
  401.   AddString(List,'1110111011101110'); AddString(List,'0000000000000000 ');
  402.   DoChoice(List,'Select a line pattern (1..8): ', '', true,
  403.             4,Input2+FontHeight+1, LinePat);
  404.   Release(TopOfHeap); List:=Nil;
  405.   LinePat:=(LinePat-1) mod 8;
  406. end; { of GetLinePattern }
  407.  
  408. { End of Utility Functions }
  409. { ------------------------ }
  410.  
  411. { Group of procedures corresponding to the different functions in XGRAPH }
  412. { ---------------------------------------------------------------------- }
  413. procedure DoVidID(var Regs:VidRegs);
  414. {
  415.   Returns the current version of the Xgraph routines.
  416. }
  417. var IOString : VidStringType;
  418.     Asnwer : integer;
  419. begin
  420.   Intr(VideoInt, Regs);
  421.   DisplayRegs(Regs);
  422.   WriteStr('BH = Major Version Number, BL = Minor Version Number.', 0,Input1,
  423.             GrfData);
  424.   delay(2000);
  425. end;
  426.  
  427. procedure DoVidInit(var Regs:VidRegs);
  428. {
  429.   Initializes the graphic raster and returns description of it to the user.
  430.   Note how the AddString and DoChoice routines can be used to display
  431.   temporary data to the user.
  432. }
  433. var IOString, NumString, NumString2 : VidStringType;
  434.     Data : GrfDataPtr;
  435.     List : StringPtr;
  436.     TopOfHeap : ^Byte;
  437.     Answer : integer;
  438. begin
  439.   Mark(TopOfHeap); List:=Nil;
  440.   Intr(VideoInt, Regs);
  441.   Data := Ptr(Regs.es, Regs.di);
  442.   DisplayRegs(Regs);
  443.  
  444.   HexString(Data^.DestOff,NumString2); HexString(Data^.DestSeg,NumString);
  445.   IOString:='Raster Address = '+NumString+':'+NumString2;
  446.   AddString(List,IOString);
  447.  
  448.   Str(Data^.RasterWidth:11,NumString);
  449.   IOString:='Raster Width   = '+NumString;
  450.   AddString(List,IOString);
  451.  
  452.   Str(Data^.MinimumX:5,NumString); Str(Data^.MinimumY:5,NumString2);
  453.   IOString:='Origen   (X,Y) = '+NumString+','+NumString2;
  454.   AddString(List,IOString);
  455.  
  456.   Str(Data^.MaximumX:5,NumString); Str(Data^.MaximumY:5,NumString2);
  457.   IOString:='End      (X,Y) = '+NumString+','+NumString2;
  458.   AddString(List,IOString);
  459.  
  460.   HexString(Data^.RowMask,NumString); HexString(Data^.ShiftIntr,NumString2);
  461.   IOString:='Mask and Inter = '+NumString+','+NumString2;      
  462.   AddString(List,IOString);
  463.  
  464.   HexString(Data^.HomeOffset,NumString); HexString(Data^.BankOffset,NumString2);
  465.   IOString:='Home and Bank  = '+NumString+','+NumString2;          
  466.   AddString(List,IOString);
  467.  
  468.   Str(Data^.PixelsPByte:11,NumString);
  469.   IOString:='Log(P in B)    = '+NumString;
  470.   AddString(List,IOString);
  471.  
  472.   HexString(Data^.TextureSeg,NumString); HexString(Data^.TextureOff,NumString2);
  473.   IOString:='Textures Addrs = '+NumString+':'+NumString2;
  474.   AddString(List,IOString);
  475.  
  476.   HexString(Data^.FontFormSeg,NumString);
  477.   HexString(Data^.FontFormOff,NumString2);
  478.   IOString:='Font1 Address  = '+NumString+':'+NumString2;
  479.   AddString(List,IOString);
  480.  
  481.   HexString(Data^.Font2FormSeg,NumString);
  482.   HexString(Data^.Font2FormOff,NumString2);
  483.   IOString:='Font2 Address  = '+NumString+':'+NumString2;
  484.   AddString(List,IOString);
  485.  
  486.   DoChoice(List,'The ES:DI register pair points to the data below.',
  487.                 'Hit Enter to continue ...', false, 4, Input2+FontHeight+1,
  488.                 Answer);
  489.   Release(TopOfHeap); List:=Nil;
  490. end;
  491.  
  492. procedure DoVidClear(var Regs:VidRegs);
  493. {
  494.   Clears the current graphic raster to black independant of video mode.
  495. }
  496. var IOString : VidStringType;
  497.     Asnwer : integer;
  498. begin
  499.   Intr(VideoInt, Regs);
  500.   PaintScreen;
  501.   DisplayRegs(Regs);
  502.   WriteStr('The Screen is cleared.', 0,Input1, GrfData);
  503.   delay(2000);
  504. end;
  505.  
  506. procedure DoVidRectFill(var Regs:VidRegs);
  507. {
  508.   Do VidRecFill of the area specified using the given pattern.
  509. }
  510. var Answer : integer;
  511. begin
  512.   Regs.ax:=Regs.ax or $000F;
  513.   DisplayRegs(Regs);
  514.  
  515.   GetPattern(Answer);
  516.   Regs.es := GrfData.TextureSeg;
  517.   Regs.bx := GrfData.TextureOff+Answer*32;
  518.   DisplayRegs(Regs);
  519.  
  520.   GetPixelCoord('Enter pixel coordinates of upper left corner (x,y): ',
  521.                 Regs.cx,Regs.dx, 200 div GrfData.BitPixelDensity,50);
  522.   DisplayRegs(Regs);
  523.   GetPixelCoord('Enter pixel coordinates of bottom right corner (x,y): ',
  524.                 Regs.si, Regs.di, 300 div GrfData.BitPixelDensity,150);
  525.  
  526.   { If rectangle points in wrong order re-order them }
  527.   if Regs.cx > Regs.si then SwapPair(Regs.cx,Regs.si);
  528.   if Regs.dx > Regs.di then SwapPair(Regs.dx,Regs.di);
  529.   DisplayRegs(Regs);
  530.  
  531.   Intr(VideoInt, Regs);
  532. end;
  533.  
  534. procedure DoVidLine(var Regs:VidRegs);
  535. {
  536.   Do VidLine functions after getting user parameter: Line coordinates and
  537.   line pattern.
  538. }
  539. var IOString : VidStringType;
  540.     Position : integer;
  541.     Answer : integer;
  542. begin
  543.   Regs.ax:=Regs.ax or $0078;
  544.   DisplayRegs(Regs);
  545.   WriteStr('Do you want to ''Xor'' or ''Plot'' the line to the screen (X/P) ?',
  546.             0,Input1, GrfData);
  547.   ReadStr(IOString, 63*FontWidth,Input1, GrfData);
  548.   if (IOString='X') or (IOString='x') then begin
  549.     Regs.ax:=Regs.ax or $0080;
  550.     DisplayRegs(Regs);
  551.   end;
  552.  
  553.   GetLinePattern(Answer);
  554.   Regs.ax:=Regs.ax or Answer;
  555.   DisplayRegs(Regs);                                 
  556.  
  557.   GetPixelCoord('Enter pixel coordinates of one endpoint (x,y): ',
  558.                 Regs.cx,Regs.dx, 325 div GrfData.BitPixelDensity,100);
  559.   DisplayRegs(Regs);
  560.  
  561.   GetPixelCoord('Enter pixel coordinates of other endpoint (x,y): ',
  562.                 Regs.si,Regs.di, 425 div GrfData.BitPixelDensity,100);
  563.   DisplayRegs(Regs);
  564.  
  565.   Intr(VideoInt, Regs);
  566. end;
  567.  
  568. procedure DoVidPolyFill(var Regs:VidRegs);
  569. {
  570.   Do VidPolyFill function after getting parameters (Polygon type, line type
  571.   fill type, vertices. Defaults to a diamond pattern of 10 vertices.
  572. }
  573. const
  574.     DefaultVertices : array[0..19] of integer = (
  575.       475, 75,  475,125,  525,125,  525, 75,  475, 75,
  576.       450,100,  500,150,  550,100,  500, 50,  500, 50 );
  577. var IOString : VidStringType; Position : integer;
  578.     Answer, PolyType : integer;
  579.     List : StringPtr;
  580.     TopOfHeap : ^Byte;
  581.     Vertices : array[0..20] of integer;
  582.     MaxVertex : integer;
  583.     Vertex : integer;
  584. begin
  585.   ClearInput;
  586.   Mark(TopOfHeap); List:=Nil;
  587.   AddString(List,'Polygon Border Only, ');
  588.   AddString(List,'Polygon and Border,');   AddString(List,'Polygon Only.');
  589.   DoChoice(List,'Select Polygon type (1..3): ', '', true,
  590.             4,Input2+FontHeight+1, PolyType);
  591.   Release(TopOfHeap); List:=Nil;
  592.   PolyType:=(PolyType-1) mod 3;
  593.   Regs.ax:=Regs.ax or $0078; Regs.cx:=Regs.cx or $000F;
  594.  
  595.   case PolyType of
  596.     0 : begin { Polygon Border Only }
  597.           GetLinePattern(Answer);
  598.           Regs.ax:=Regs.ax or Answer;
  599.         end;
  600.     1 : begin { Polygon and Border }
  601.           Regs.cx:=Regs.cx or $0100;
  602.           GetLinePattern(Answer);
  603.           Regs.ax:=Regs.ax or Answer;
  604.           GetPattern(Answer);
  605.           Regs.es := GrfData.TextureSeg;
  606.           Regs.bx := GrfData.TextureOff+Answer*32;
  607.         end;
  608.     2 : begin { Polygon Only }
  609.           Regs.cx:=Regs.cx or $0500;
  610.           GetPattern(Answer);
  611.           Regs.es := GrfData.TextureSeg;
  612.           Regs.bx := GrfData.TextureOff+Answer*32;
  613.         end
  614.   end;
  615.   DisplayRegs(Regs);
  616.  
  617.   ClearInput;
  618.   IOString:='Number of Vertices (3..10):';
  619.   WriteStr(IOString, 0,Input1, GrfData);
  620.   ReadStr(IOString, (Length(IOString)+1)*FontWidth,Input1, GrfData);
  621.   Position:=1;
  622.   if not(GetNum(IOString, Position, MaxVertex)) then MaxVertex:=10;
  623.   if (MaxVertex<3) or (MaxVertex>10) then MaxVertex:=10;
  624.  
  625.   Vertices[0]:=MaxVertex;
  626.   for Vertex:=1 to MaxVertex do begin
  627.     Str(Vertex, IOString);
  628.     IOString:='Enter vertex #'+IOString+', (x,y):';
  629.     GetPixelCoord(IOString, Vertices[Vertex*2-1],Vertices[Vertex*2],
  630.                   DefaultVertices[Vertex*2-2] div GrfData.BitPixelDensity,
  631.                   DefaultVertices[Vertex*2-1]);
  632.   end;
  633.   Regs.ds:=seg(Vertices); Regs.si:=ofs(Vertices);
  634.   Intr(VideoInt, Regs);
  635.   DisplayRegs(Regs);
  636. end;
  637.  
  638. procedure DoVidBlit(var Regs:VidRegs);
  639. {
  640.   Do a simplified blit function. Only allows to blit areas on the display and
  641.   in EGA's case always uses all bit-planes (i.e no color). This is a
  642.   limitation of SMPLXGRF not of the Blit function!. It defaults to bliting 
  643.   the VidRectFill rectangle over to the VidPolyFill area.
  644. }
  645. var IOString : VidStringType; Position : integer;
  646.     Answer : integer;
  647.     List : StringPtr;
  648.     TopOfHeap : ^Byte;
  649.     BlitParms : BlitParm;
  650. begin
  651.   ClearInput;
  652.   Regs.bx := $010F;
  653.   Regs.ds := seg(BlitParms); Regs.si:=ofs(BlitParms);
  654.   DisplayRegs(Regs);
  655.   with BlitParms, GrfData do begin
  656.     DestOffset:=ofs(GrfData); DestSegment:=seg(GrfData);
  657.     SrcOffset:=ofs(GrfData); SrcSegment:=seg(GrfData);
  658.     TextSegment:=TextureSeg; TextOffset:=TextureOff;
  659.   end;
  660.  
  661.   Mark(TopOfHeap); List:=Nil;
  662.   AddString(List,'0,');                     AddString(List,'Src and Dst,');
  663.   AddString(List,'Src and Not(Dst),');      AddString(List,'Src,');
  664.   AddString(List,'Not(Src) and Dst,');      AddString(List,'Dst,');
  665.   AddString(List,'Src xor Dst,');           AddString(List,'Src or Dst,');
  666.   AddString(List,'Not(Src) and Not(Dst),'); AddString(List,'Not(Src) xor Dst,');
  667.   AddString(List,'Not(Dst),');              AddString(List,'Src or Not(Dst),');
  668.   AddString(List,'Not(Src),');              AddString(List,'Not(Src) or Dst,');
  669.   AddString(List,'Not(Src) or Not(Dst),');  AddString(List,'1,');
  670.   Answer:=BlitS;
  671.   DoChoice(List,'Select Blit operation (1..16): ', '', true,
  672.             4,Input2+FontHeight+1, Answer);
  673.   Release(TopOfHeap); List:=Nil;
  674.   Answer:=(Answer-1) mod 16;
  675.   BlitParms.Opcode:=Answer;
  676.   
  677.   if BlitParms.Opcode in  { Needs source }
  678.     [BlitSandD, BlitSandND, BlitS, BlitNSandD, BlitSxorD, BlitSorD,
  679.      BlitNSandND, BlitNSxorD, BlitSorND, BlitNS, BlitNSorD, BlitNSorND]
  680.   then begin
  681.     Mark(TopOfHeap); List:=Nil;
  682.     AddString(List,'0,');                 AddString(List,'1,');
  683.     AddString(List,'Src,');               AddString(List,'Pat,'); 
  684.     AddString(List,'Src or Pat,');        AddString(List,'Src and Pat,');
  685.     AddString(List,'Src xor Pat,');       AddString(List,'Not(Pat),');
  686.     AddString(List,'Src or Not(Pat),');   AddString(List,'Src and Not(Pat),');
  687.     AddString(List,'Src xor Not(Pat). ');
  688.     Answer:=TextS; 
  689.     DoChoice(List,'Select source texturing operation (1..11): ', '', true,
  690.               4,Input2+FontHeight+1, Answer);
  691.     Release(TopOfHeap); List:=Nil; Mark(TopOfHeap);
  692.     Answer:=(Answer-1) mod 11;
  693.     BlitParms.TextOp:=Answer;
  694.  
  695.     if BlitParms.TextOp in
  696.       [TextP, TextSorP, TextSandP, TextSxorP, TextNP, TextSorNP,
  697.        TextSandNP, TextSxorNP] then begin
  698.       GetPattern(Answer);
  699.       BlitParms.TextOffset := BlitParms.TextOffset+Answer*32;
  700.     end;
  701.   end
  702.   else BlitParms.TextOP:=Text0;
  703.  
  704.   GetBitCoord('Enter bit coord of Destination''s upper left corner (x,y): ',
  705.                 BlitParms.RectOrigenX,BlitParms.RectOrigenY, 450,50);
  706.   GetBitCoord('Enter bit coord of Destination''s bottom right corner (x,y): ',
  707.                 BlitParms.RectCornerX, BlitParms.RectCornerY, 550,150);
  708.   if BlitParms.RectOrigenX > BlitParms.RectCornerX then
  709.     SwapPair(BlitParms.RectOrigenX,BlitParms.RectCornerX);
  710.   if BlitParms.RectOrigenY > BlitParms.RectCornerY then
  711.     SwapPair(BlitParms.RectOrigenY,BlitParms.RectCornerY);
  712.  
  713.   if BlitParms.Opcode in  { Needs source }
  714.     [BlitSandD, BlitSandND, BlitS, BlitNSandD, BlitSxorD, BlitSorD,
  715.      BlitNSandND, BlitNSxorD, BlitSorND, BlitNS, BlitNSorD, BlitNSorND] then
  716.     GetBitCoord('Enter bit coord of Source''s origen (x,y): ',
  717.                   BlitParms.PointX,BlitParms.PointY, 200,50)
  718.   else begin
  719.     BlitParms.PointX := BlitParms.RectOrigenX;
  720.     BlitParms.PointY := BlitParms.RectOrigenY;
  721.   end;
  722.  
  723.  
  724.   Intr(VideoInt, Regs);
  725.   DisplayRegs(Regs);
  726. end;
  727. { End of XGRAPH procedures }
  728. { ------------------------ }
  729.  
  730. { Utility functions directly accessible by the user: }
  731. { -------------------------------------------------- }
  732. procedure DoVidSetMode(var Regs : VidRegs);
  733. {
  734.   Allows the user to select a new video mode. This allows to test the
  735.   XGRAPH routines in all graphic raster configurations that the adapter
  736.   can support.
  737. }
  738. var IOString : VidStringType;
  739.     Mode, code : integer;
  740. begin
  741.   ClearInput;
  742.   IOString:='Enter new video mode: ';
  743.   WriteStr(IOString, 0,Input1, GrfData);
  744.   ReadStr(IOString, (Length(IOString)+1)*FontWidth,Input1, GrfData);
  745.   Val(IOString,Mode,Code);
  746.   if Code<>0 then Mode:=-1
  747.      else Regs.ax:=Regs.ax+Mode;
  748.   GraphInit(GrfData,Mode);
  749.   if GrfData.CurrFont = 1 then begin
  750.     Input1:=0; Input2:=8;
  751.     Output1:=GrfData.MaximumY-16; Output2:=GrfData.MaximumY-8;
  752.     FontHeight:=8; FontWidth:=8;
  753.   end
  754.   else begin
  755.     Input1:=0; Input2:=14;
  756.     Output1:=GrfData.MaximumY-28; Output2:=GrfData.MaximumY-14;
  757.     FontHeight:=14; FontWidth:=8;
  758.   end;
  759.  
  760.   PaintScreen;
  761.   DisplayRegs(Regs);
  762. end;
  763.  
  764. procedure DumpGraphics;
  765. {
  766.   Simple procedure to dump the current graphic screen to an Epson/IBM
  767.   compatible printer. Warning only tested on an Epson EX-800 printer.
  768. }
  769. var
  770.   CharPtr : CharPtrType;
  771.   PrnRaster : Raster;
  772.   LocalBlitParms : BlitParm;
  773.   LocalRegs : VidRegs;
  774.   TopOfHeap : ^byte;
  775.   i : integer;
  776.  
  777.   procedure DumpColumn(Number:integer; CharPtr : CharPtrType);
  778.   var i : integer;
  779.   begin
  780.     Number:=Number+100;
  781.     write(Lst,chr(27),'K',chr(Number mod 256),chr(Number div 256));
  782.     for i:=1 to 100 do write(Lst,chr(0));
  783.     for i:=101 to Number do begin
  784.       write(Lst,chr(CharPtr^));
  785.       CharPtr := Ptr(Seg(CharPtr^),Ofs(CharPtr^)-1);
  786.     end;
  787.     writeln(Lst);
  788.   end;
  789.  
  790. begin
  791.   Mark(TopOfHeap);
  792.   GetMem(CharPtr, GrfData.MaximumY-GrfData.MinimumY+1);
  793.   with PrnRaster do begin
  794.     Offset:=Ofs(CharPtr^); Segment:=Seg(CharPtr^);
  795.     Width:=1; OrigenX:=0; OrigenY:=0;
  796.     CornerX:=7; CornerY:=GrfData.MaximumY-GrfData.MinimumY
  797.   end;
  798.   CharPtr:=Ptr(Seg(CharPtr^),Ofs(CharPtr^)+GrfData.MaximumY-GrfData.MinimumY);
  799.  
  800.   with LocalBlitParms do begin
  801.     DestOffset:=Ofs(PrnRaster); DestSegment:=Seg(PrnRaster);
  802.     SrcOffset:=Ofs(GrfData); SrcSegment:=Seg(GrfData);
  803.     RectOrigenX:=0; RectOrigenY:=0;
  804.     RectCornerX:=7; RectCornerY:=PrnRaster.CornerY;
  805.     PointX:=0; PointY:=0;
  806.     Opcode:=BlitS; TextOp:=TextS;
  807.   end;
  808.  
  809.   with LocalRegs do begin
  810.     ax:=VidBlit shl 8; bx:=$010F;
  811.     ds:=Seg(LocalBlitParms); si:=Ofs(LocalBlitParms);
  812.   end;
  813.  
  814.   writeln(Lst,chr(27),'A',chr(8),chr(27),'2');
  815.   for i:=1 to (GrfData.MaximumX-GrfData.MinimumX+1) div 8 do begin
  816.     Intr(VideoInt, LocalRegs);
  817.     DumpColumn(GrfData.MaximumY-GrfData.MinimumY+1,CharPtr);
  818.     LocalBlitParms.PointX:=LocalBlitParms.PointX+8;
  819.   end;
  820.  
  821.   writeln(Lst,chr(27),'@');
  822.   write(Lst,chr(12));
  823.   release(TopOfHeap);
  824. end; { of DumpGraphics }
  825. { End of utilities accessible to the user. }
  826. { ---------------------------------------- }
  827.  
  828. procedure GetFunction( var Regs : VidRegs; var Done : Boolean);
  829. {
  830.   Procedure to get an XGRAPH function and its parameters or a utility
  831.   function from the user. This is the "main" loop of the program.
  832. }
  833. var FunctionsStr : StringPtr;
  834.     TopOfHeap : ^byte;
  835.     Answer : integer;
  836. begin
  837.   Done := false;
  838.   Mark(TopOfHeap);
  839.   FunctionsStr:=Nil;
  840.   AddString(FunctionsStr,'VidID,');
  841.   AddString(FunctionsStr,'VidInit,');       AddString(FunctionsStr,'VidClear,');
  842.   AddString(FunctionsStr,'VidRectFill, ');  AddString(FunctionsStr,'VidLine,');
  843.   AddString(FunctionsStr,'VidPolyFill,');   AddString(FunctionsStr,'VidBlit,');
  844.   AddString(FunctionsStr,'Change Mode,');   AddString(FunctionsStr,'PrintScr,');
  845.   AddString(FunctionsStr,'Or Quit.');
  846.   repeat
  847.     DoChoice(FunctionsStr,'Select video function number or Quit:', '', true,
  848.       4,Input2+FontHeight+1, Answer);
  849.   until (Answer>0) and (Answer<11);
  850.  
  851.   Release(TopOfHeap); FunctionsStr:=Nil;
  852.   ClearRegs(Regs);
  853.   Regs.ax:=(Answer+$A2) shl 8;
  854.   case Answer of
  855.     1 : DoVidId(Regs);
  856.     2 : DoVidInit(Regs);
  857.     3 : DoVidClear(Regs);
  858.     4 : DoVidRectFill(Regs);
  859.     5 : DoVidLine(Regs);
  860.     6 : DoVidPolyFill(Regs);
  861.     7 : DoVidBlit(Regs);
  862.     8 : begin Regs.ax := VidSetMode shl 8; DoVidSetMode(Regs) end;
  863.     9 : DumpGraphics;
  864.    10 : Done:=true
  865.     end;
  866. end; { of GetFunctions }
  867.   
  868. begin { of main }
  869.   
  870.   { Find XGRAPH routines }
  871.   with Regs do begin
  872.     ax:=VidId shl 8; bx:=$FFFF;
  873.     Intr(VideoInt, Regs);
  874.   end;
  875.   if Regs.bx <> $FFFF then begin
  876.     GraphInit(GrfData,-1);
  877.     if GrfData.VideoMode <> -1 then begin { Adapter can do graphics }
  878.       if GrfData.CurrFont = 1 then begin { 200 lines graphics }
  879.         Input1:=0; Input2:=8;
  880.         Output1:=GrfData.MaximumY-16; Output2:=GrfData.MaximumY-8;
  881.         FontHeight:=8; FontWidth:=8;
  882.       end
  883.       else begin { > 200 lines graphics }
  884.         Input1:=0; Input2:=14;
  885.         Output1:=GrfData.MaximumY-28; Output2:=GrfData.MaximumY-14;
  886.         FontHeight:=14; FontWidth:=8;
  887.       end;
  888.  
  889.       PaintScreen;
  890.       WriteStr('SmplXgrf: A Simple Xgraph.exe user interface',
  891.         0,Input1,GrfData);
  892.       WriteStr('written by Abe Achkinazi on March 11, 1987.',
  893.         0,Input2,GrfData);
  894.       Delay(2000);
  895.       repeat
  896.         ClearInput;
  897.         WriteStr('Hit a key to activate function menu.', 0,Input1, GrfData);
  898.         repeat until KeyPressed;
  899.         read(kbd,c);
  900.         GetFunction(Regs, Done);
  901.       until Done;
  902.       TextMode;
  903.     end
  904.     else begin { No graphic modes }
  905.       writeln('Current video configuration does not allow graphics.');
  906.       writeln('Must have a CGA or EGA type adapter as the primary display.');
  907.     end;
  908.   end
  909.   else writeln('XGRAPH routines not found. Install then running XGRAPH.EXE.');
  910. end.
  911.