ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng)/ProfitPress-MegaCDROM2.B6I/GRAPHICS/PLOT/SURFUTI3.ZIP/GXGIN.PAS

Pascal/Delphi Source File | 1988-02-03 | 5.2 KB | 177 lines

  {$U-$V-} {disable CNTRL C, disable strict string length type checking}

{                 FOR USE WITH GXBASE PACKAGE
 Graphics INput package.  Enables/Disables cross-hairs and allows user to
 input the cursor coordinates in response to a keyboard character selected.
 X-Y coordinates are screen values in the range 0..319, 0..199 respectively.

 Cursor movements are defined by the keys:

    up = ^I;   down = ^M;   left = ^J;  right = ^L;
    nw = ^U;   sw   = ^N;   ne   = ^O;  se    = ^K;

 The movement is one pixel at a time, but can be set to n-pixel steps by
 pressing the ESC key followed by any numeric key in the range 1 to 9.
}

VAR

  {Graphics INput global variables}

  GxGinStep : Integer; {cross-hair step length}
  GxGinOn : Boolean; {Gin status flag}
  GinBeamX, GinBeamY : Integer; {Cross-hair coordinates}
  GxGinIndex : Integer;

  { Read the kbd for a char, If its an F key}
  { or an arrow key then a flag is set}
  FUNCTION getch : Integer;
  VAR Ch : Char;
    arrow : Boolean;
  BEGIN
    Read(Kbd, Ch);
    arrow := False;
    IF ((Ord(Ch) = Esc) AND KeyPressed) THEN
      BEGIN
        arrow := True;
        Read(Kbd, Ch)
      END;
    IF arrow THEN getch := Ord(Ch)+170
    ELSE getch := Ord(Ch)
  END;


  PROCEDURE GinStep(n : Integer);
  BEGIN
    GxGinStep := n AND 15;
  END {GinStep} ;

  PROCEDURE GinColour(index : Integer);
  BEGIN
    GxGinIndex := index AND $F;
  END {GinColour} ;

  PROCEDURE GinEnable;

    {allow interactive input with a default step displacement of one pixel.}

  BEGIN
    GinBeamX := (GxVxb+GxVxt) SHR 1;
    GinBeamY := (GxVyt+GxVyb) SHR 1;
    GxGinOn := True;
    GxGinStep := 15;
    GxGinIndex := GxPalette[15]; {white cross-hairs for default map}
  END {GinEnable} ;

  PROCEDURE GinDisable;

    {disable interactive input}

  BEGIN
    GinBeamX := -1; GinBeamY := -1;
    GxGinOn := False;
  END {GinDisable} ;

  PROCEDURE Gin(VAR GinC : Char; VAR GinX, GinY : Real);

  {allow user to move cross-hair cursor and fix coordinates of cursor in
   response to a keyboard character.  Return coords of cross-hairs in GinX,
   GinY and the key depressed in GinC}

  TYPE
    direction = Integer;

  CONST
    Up = 242; Down = 250; Left = 245; Right = 247;
    nw = 241; sw = 249; ne = 243; se = 251;
    Esc = 27;
    movement : SET OF 7..253 = [Up, Down, Left, Right, nw, sw, ne, se];


  VAR
    c : Integer;
    step : Integer;
    newX, newY : Integer;
    mode : Integer;
    CurrIndex : Integer;

  BEGIN
    IF GxGinOn THEN
      BEGIN
        mode := GxMode;
        WriteModeXor;
        CurrIndex := GxIndex;
        GxIndex := GxGinIndex;
        step := GxGinStep;
        newX := GinBeamX; newY := GinBeamY;
        DrawLine(newX, GxVyb, newX, GxVyt);
        DrawLine(GxVxb, newY, GxVxt, newY);
        REPEAT
          c := getch;

          IF Chr(c) IN ['0'..'9'] THEN
            BEGIN
              IF Chr(c) IN ['1'..'9'] THEN
                step := c-Ord('0')
              ELSE
                IF Chr(c) = '0' THEN step := 15;
            END; { if chr(c) in..}

          IF c IN movement THEN
            BEGIN
              CASE c OF
                Up : newY := (GinBeamY-step);
                Down : newY := (GinBeamY+step);
                Right : newX := (GinBeamX+step);
                Left : newX := (GinBeamX-step);
                nw : BEGIN
                       newX := (GinBeamX-step); newY := (GinBeamY-step);
                     END;
                ne : BEGIN
                       newX := (GinBeamX+step); newY := (GinBeamY-step);
                     END;
                sw : BEGIN
                       newX := (GinBeamX-step); newY := (GinBeamY+step);
                     END;
                se : BEGIN
                       newX := (GinBeamX+step); newY := (GinBeamY+step);
                     END;
              END {case} ;
              IF newX < GxVxb THEN newX := GxVxt-GxVxb+newX;
              IF newX > GxVxt THEN newX := GxVxb+newX-GxVxt;
              IF newY > GxVyb THEN newY := GxVyt-GxVyb+newY;
              IF newY < GxVyt THEN newY := GxVyb+newY-GxVyt;
              IF newX <> GinBeamX THEN
                BEGIN
                  DrawLine(GinBeamX, GxVyb, GinBeamX, GxVyt);
                  DrawLine(newX, GxVyb, newX, GxVyt);
                END;
              IF newY <> GinBeamY THEN
                BEGIN
                  DrawLine(GxVxb, GinBeamY, GxVxt, GinBeamY);
                  DrawLine(GxVxb, newY, GxVxt, newY);
                END;
              GinBeamX := newX; GinBeamY := newY;
            END; { if c in...}
        UNTIL (NOT(c IN (movement+[Esc]))) AND (NOT(Chr(c) IN ['0'..'9']));

        GinC := Chr(c);
        GinX := GxWxb+(GinBeamX-GxVxb)/GxSx;
        GinY := GxWyb+(GinBeamY-GxVyb)/GxSy;
        GxGinStep := step;

        {delete X-hairs until next GIN call}

        DrawLine(GinBeamX, GxVyb, GinBeamX, GxVyt);
        DrawLine(GxVxb, GinBeamY, GxVxt, GinBeamY);

        {restore user's environment}

        IF mode = GxSet THEN
          WriteModeSet
        ELSE
          WriteModeXor;
        GxIndex := CurrIndex;
      END;
  END {gin} ;