home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / TPJOYSTK.ZIP / JOYSTICK.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-11-14  |  2.7 KB  |  120 lines
  1. Unit Joystick;
  2. Interface
  3.  Uses Crt;
  4.  
  5.  { Joystick interface for Turbo Pascal V. 4.0 and above
  6.    Public Domain, November 1989 by
  7.    JonSoft Technologies Inc.
  8.    (C) 1989 JonSoft Technologies Inc. }
  9.  
  10. CONST
  11.  centX : Byte=80;
  12.  centY : Byte=40;
  13.  Joyst : BOOLEAN=TRUE;
  14.  
  15. PROCEDURE FastInitJS;
  16. PROCEDURE BetterInitJS( range : Byte );
  17. FUNCTION joy_X : Byte;
  18. FUNCTION joy_Y : Byte;
  19. FUNCTION button_1 : Byte;
  20. FUNCTION button_2 : Byte;
  21. FUNCTION Horiz : shortint;
  22. FUNCTION Vert : shortint;
  23.  
  24.  
  25. Implementation
  26.  
  27. CONST
  28.  rangexm : Byte=25;
  29.  rangeym : Byte=20;
  30.  rangexp : Byte=25;
  31.  rangeyp : Byte=25;
  32.  
  33. FUNCTION joy_X : Byte;
  34.   VAR
  35.     x : Word;
  36.   BEGIN
  37.     x := 0;
  38.     Port[$201] := $ff;
  39.     WHILE Port[$201] AND $1=1 DO Inc(x);
  40.     joy_X := x;
  41.   END;
  42.  
  43. FUNCTION joy_Y : Byte;
  44.   VAR
  45.     y : Word;
  46.   BEGIN
  47.     y := 0;
  48.     Port[$201] := $0;
  49.     WHILE Port[$201] AND $2=2 DO Inc(y);
  50.     joy_Y := y;
  51.   END;
  52.  
  53. PROCEDURE FastInitJs;
  54.   BEGIN
  55.     centX := joy_X;
  56.     centY := joy_Y;
  57.   END;
  58.  
  59. FUNCTION button_1 : Byte;
  60.   BEGIN
  61.     button_1 := ((Port[$201] AND $10) XOr $10) ShR 4;
  62.   END;
  63.  
  64. FUNCTION button_2 : Byte;
  65.   BEGIN
  66.     button_2 := ((Port[$201] AND $20) XOr $20) ShR 5;
  67.   END;
  68.  
  69. PROCEDURE BetterInitJs(range : Byte);
  70.   VAR
  71. (*    Ch : CHAR; *)
  72.     uprjoyX, uprjoyY, centrjoyX, centrjoyY, lowrjoyX, lowrjoyY : Byte;
  73.  
  74. BEGIN
  75.  WRITELN('Are you using a joystick? (Button = yes, RETURN = no)');
  76.  REPEAT
  77.   IF button_1+button_2 > 0 THEN Joyst := TRUE;
  78.   IF KeyPressed THEN Joyst := FALSE;
  79.  UNTIL (button_1+button_2 > 0) OR KeyPressed;
  80.  IF Joyst = TRUE THEN BEGIN
  81.   REPEAT UNTIL button_1+button_2 = 0;
  82.   WRITELN('Move joystick to UPPER RIGHT corner and press a button.');
  83.   REPEAT UNTIL button_1+button_2 > 0;
  84.   uprjoyX := joy_X;
  85.   uprjoyY := joy_Y;
  86.   REPEAT UNTIL button_1+button_2 = 0;
  87.   WRITELN('Move joystick to CENTER and press a button.');
  88.   REPEAT UNTIL button_1+button_2 > 0;
  89.   centrjoyX := joy_X;
  90.   centrjoyY := joy_Y;
  91.   centX := centrjoyX;
  92.   centY := centrjoyY;
  93.   REPEAT UNTIL button_1+button_2 = 0;
  94.   WRITELN('Move joystick to LOWER LEFT CORNER and press a button.');
  95.   REPEAT UNTIL button_1+button_2 > 0;
  96.   lowrjoyX := joy_X;
  97.   lowrjoyY := joy_Y;
  98.   rangexm := (centrjoyX-uprjoyX) DIV range;
  99.   rangexp := (lowrjoyX-centrjoyX) DIV range;
  100.   rangeym := (centrjoyY-uprjoyY) DIV range;
  101.   rangeyp := (lowrjoyY-centrjoyY) DIV range;
  102.  END;
  103. END;
  104.  
  105. FUNCTION Horiz : shortint;
  106.   BEGIN
  107.     IF joy_X<centX-rangexm THEN Horiz := -1
  108.     ELSE IF joy_X > centX+rangexp THEN Horiz := 1
  109.     ELSE Horiz := 0;
  110.   END;
  111.  
  112. FUNCTION Vert : shortint;
  113.   BEGIN
  114.     IF joy_Y<centY-rangeym THEN Vert := -1
  115.     ELSE IF joy_Y > centY+rangeyp THEN Vert := 1
  116.     ELSE Vert := 0;
  117.   END;
  118.  
  119. END.
  120.