mirror of
https://github.com/QB64-Phoenix-Edition/QB64pe.git
synced 2024-07-06 03:30:23 +00:00
9ee89d6ff4
These tests use a variety of sample code (with some of the larger files removed, so they are not complete!) and verifies that they all compile successfully.
321 lines
5.9 KiB
QBasic
321 lines
5.9 KiB
QBasic
CHDIR ".\programs\samples\thebob\chess"
|
|
|
|
'CHESSUBS.BAS
|
|
DEFINT A-Z
|
|
DECLARE FUNCTION InitMOUSE ()
|
|
DECLARE SUB MouseSTATUS (LB, RB, MouseX, MouseY)
|
|
DECLARE SUB ShowMOUSE ()
|
|
DECLARE SUB HideMOUSE ()
|
|
DECLARE SUB LocateMOUSE (x, y)
|
|
DECLARE SUB FieldMOUSE (x1, y1, x2, y2)
|
|
DECLARE SUB PauseMOUSE (LB, RB, MouseX, MouseY)
|
|
DECLARE SUB ClearMOUSE ()
|
|
DECLARE SUB MouseDRIVER (LB, RB, MX, MY)
|
|
DECLARE SUB LoadSCREEN ()
|
|
DECLARE SUB SetPALETTE ()
|
|
DECLARE SUB PutPIECE (OldROW, OldCOL, NewROW, NewCOL)
|
|
DECLARE SUB ClearSQUARE (Row, Col)
|
|
DECLARE SUB HighLIGHT (Row, Col, OnOFF)
|
|
|
|
DIM SHARED MouseDATA$
|
|
DIM SHARED LB, RB
|
|
|
|
'Create and load MouseDATA$ for CALL ABSOLUTE routines
|
|
DATA 55,89,E5,8B,5E,0C,8B,07,50,8B,5E,0A,8B,07,50,8B,5E,08,8B
|
|
DATA 0F,8B,5E,06,8B,17,5B,58,1E,07,CD,33,53,8B,5E,0C,89,07,58
|
|
DATA 8B,5E,0A,89,07,8B,5E,08,89,0F,8B,5E,06,89,17,5D,CA,08,00
|
|
MouseDATA$ = SPACE$(57)
|
|
FOR i = 1 TO 57
|
|
READ h$
|
|
Hexxer$ = CHR$(VAL("&H" + h$))
|
|
MID$(MouseDATA$, i, 1) = Hexxer$
|
|
NEXT i
|
|
|
|
Moused = InitMOUSE
|
|
IF NOT Moused THEN
|
|
PRINT "Sorry, cat must have got the mouse."
|
|
SLEEP 2
|
|
SYSTEM
|
|
END IF
|
|
|
|
BoardDATA:
|
|
DATA 2, 3, 4, 5, 6, 4, 3, 2
|
|
DATA 1, 1, 1, 1, 1, 1, 1, 1
|
|
DATA 0, 0, 0, 0, 0, 0, 0, 0
|
|
DATA 0, 0, 0, 0, 0, 0, 0, 0
|
|
DATA 0, 0, 0, 0, 0, 0, 0, 0
|
|
DATA 0, 0, 0, 0, 0, 0, 0, 0
|
|
DATA 11, 11, 11, 11, 11, 11, 11, 11
|
|
DATA 12, 13, 14, 15, 16, 14, 13, 12
|
|
|
|
DIM SHARED Box(1 TO 26000)
|
|
DIM SHARED LilBOX(1 TO 800)
|
|
DIM SHARED Board(1 TO 8, 1 TO 8)
|
|
|
|
CONST King = 1
|
|
CONST Queen = 751
|
|
CONST Bishop = 1501
|
|
CONST Knight = 2251
|
|
CONST Rook = 3001
|
|
CONST Pawn = 3751
|
|
CONST White = 0 'piece color
|
|
CONST Black = 4500 'piece color
|
|
CONST Light = 0 'square color
|
|
CONST Dark = 9000 'square color
|
|
CONST ELight = 18751 'erase light square
|
|
CONST EDark = 18001 'erase dark square
|
|
|
|
SCREEN 12
|
|
|
|
SetPALETTE
|
|
LoadSCREEN
|
|
COLOR 7: LOCATE 29, 22: PRINT "PRESS ESC TO QUIT";
|
|
LocateMOUSE 254, 194
|
|
ShowMOUSE
|
|
DO
|
|
k$ = INKEY$
|
|
MouseSTATUS LB, RB, MouseX, MouseY
|
|
SELECT CASE MouseX
|
|
CASE 31 TO 80: Col = 1
|
|
CASE 81 TO 130: Col = 2
|
|
CASE 131 TO 180: Col = 3
|
|
CASE 181 TO 230: Col = 4
|
|
CASE 231 TO 280: Col = 5
|
|
CASE 281 TO 330: Col = 6
|
|
CASE 331 TO 380: Col = 7
|
|
CASE 381 TO 430: Col = 8
|
|
END SELECT
|
|
SELECT CASE MouseY
|
|
CASE 31 TO 80: Row = 1
|
|
CASE 81 TO 130: Row = 2
|
|
CASE 131 TO 180: Row = 3
|
|
CASE 181 TO 230: Row = 4
|
|
CASE 231 TO 280: Row = 5
|
|
CASE 281 TO 330: Row = 6
|
|
CASE 331 TO 380: Row = 7
|
|
CASE 381 TO 430: Row = 8
|
|
END SELECT
|
|
|
|
IF LB = -1 THEN
|
|
SELECT CASE Clicked
|
|
CASE 0
|
|
ExROW = Row: ExCOL = Col
|
|
HighLIGHT Row, Col, 1
|
|
Clicked = 1
|
|
CASE 1
|
|
IF ExROW = Row AND ExCOL = Col THEN
|
|
HighLIGHT Row, Col, 0
|
|
ELSE
|
|
PutPIECE ExROW, ExCOL, Row, Col
|
|
END IF
|
|
Clicked = 0
|
|
END SELECT
|
|
END IF
|
|
|
|
ClearMOUSE
|
|
LOOP UNTIL k$ = CHR$(27)
|
|
|
|
SYSTEM
|
|
|
|
PaletteDATA:
|
|
DATA 12,0,10, 17,19,17, 20,22,20, 23,25,23
|
|
DATA 63,0,0, 63,60,50, 58,55,45, 53,50,40
|
|
DATA 0,0,0, 42,42,48, 50,50,55, 40,40,63
|
|
DATA 15,15,34, 58,37,15, 60,52,37, 63,63,63
|
|
|
|
SUB ClearMOUSE
|
|
|
|
WHILE LB OR RB
|
|
MouseSTATUS LB, RB, MouseX, MouseY
|
|
WEND
|
|
|
|
END SUB
|
|
|
|
SUB ClearSQUARE (Row, Col)
|
|
|
|
IF (Col + Row MOD 2) MOD 2 THEN Square = EDark ELSE Square = ELight
|
|
x = Col * 50 - 19
|
|
y = Row * 50 - 19
|
|
PUT (x, y), Box(Square), PSET
|
|
|
|
END SUB
|
|
|
|
SUB FieldMOUSE (x1, y1, x2, y2)
|
|
|
|
MouseDRIVER 7, 0, x1, x2
|
|
MouseDRIVER 8, 0, y1, y2
|
|
|
|
END SUB
|
|
|
|
SUB HideMOUSE
|
|
|
|
LB = 2
|
|
MouseDRIVER LB, 0, 0, 0
|
|
|
|
END SUB
|
|
|
|
SUB HighLIGHT (Row, Col, OnOFF)
|
|
STATIC SquareON, Oldx, Oldy
|
|
|
|
IF SquareON AND OnOFF = 0 THEN
|
|
HideMOUSE
|
|
PUT (Oldx, Oldy), LilBOX, PSET
|
|
ShowMOUSE
|
|
SquareON = 0
|
|
EXIT SUB
|
|
END IF
|
|
|
|
x = Col * 50 - 19
|
|
y = Row * 50 - 19
|
|
HideMOUSE
|
|
GET (x, y)-(x + 46, y + 46), LilBOX
|
|
LINE (x, y)-(x + 46, y + 46), 4, B
|
|
LINE (x + 1, y + 1)-(x + 45, y + 45), 4, B
|
|
ShowMOUSE
|
|
SquareON = 1: Oldx = x: Oldy = y
|
|
|
|
END SUB
|
|
|
|
FUNCTION InitMOUSE
|
|
|
|
LB = 0
|
|
MouseDRIVER LB, 0, 0, 0
|
|
InitMOUSE = LB
|
|
|
|
END FUNCTION
|
|
|
|
SUB LoadSCREEN
|
|
|
|
'Loads screen and then loads chess pieces into Box array
|
|
FileNUM = 0
|
|
DEF SEG = VARSEG(Box(1))
|
|
FOR y = 0 TO 320 STEP 160
|
|
FileNUM = FileNUM + 1
|
|
FileNAME$ = "ChessBD" + LTRIM$(STR$(FileNUM)) + ".BSV"
|
|
BLOAD FileNAME$, VARPTR(Box(1))
|
|
PUT (0, y), Box, PSET
|
|
NEXT y
|
|
BLOAD "chesspcs.bsv", VARPTR(Box(1))
|
|
DEF SEG
|
|
|
|
'read starting values into map array
|
|
RESTORE BoardDATA
|
|
FOR Col = 1 TO 8
|
|
FOR Row = 1 TO 8
|
|
READ Board(Col, Row)
|
|
NEXT Row
|
|
NEXT Col
|
|
|
|
END SUB
|
|
|
|
SUB LocateMOUSE (x, y)
|
|
|
|
LB = 4
|
|
MX = x
|
|
MY = y
|
|
MouseDRIVER LB, 0, MX, MY
|
|
|
|
END SUB
|
|
|
|
SUB MouseDRIVER (LB, RB, MX, MY)
|
|
|
|
DEF SEG = VARSEG(MouseDATA$)
|
|
mouse = SADD(MouseDATA$)
|
|
CALL ABSOLUTE_MOUSE_EMU (LB, RB, MX, MY)
|
|
|
|
END SUB
|
|
|
|
SUB MouseSTATUS (LB, RB, MouseX, MouseY)
|
|
|
|
LB = 3
|
|
MouseDRIVER LB, RB, MX, MY
|
|
LB = ((RB AND 1) <> 0)
|
|
RB = ((RB AND 2) <> 0)
|
|
MouseX = MX
|
|
MouseY = MY
|
|
|
|
END SUB
|
|
|
|
SUB PauseMOUSE (OldLB, OldRB, OldMX, OldMY)
|
|
|
|
|
|
SHARED Key$
|
|
|
|
DO
|
|
Key$ = UCASE$(INKEY$)
|
|
MouseSTATUS LB, RB, MouseX, MouseY
|
|
LOOP UNTIL LB <> OldLB OR RB <> OldRB OR MouseX <> OldMX OR MouseY <> OldMY OR Key$ <> ""
|
|
|
|
END SUB
|
|
|
|
SUB PutPIECE (Row1, Col1, Row2, Col2)
|
|
|
|
IF Board(Row1, Col1) <> 0 THEN
|
|
SELECT CASE Board(Row1, Col1) MOD 10
|
|
CASE 1: Piece = Pawn
|
|
CASE 2: Piece = Rook
|
|
CASE 3: Piece = Knight
|
|
CASE 4: Piece = Bishop
|
|
CASE 5: Piece = Queen
|
|
CASE 6: Piece = King
|
|
END SELECT
|
|
|
|
IF (Col1 + Row1 MOD 2) MOD 2 THEN Cancel = EDark ELSE Cancel = ELight
|
|
IF (Col2 + Row2 MOD 2) MOD 2 THEN Square = Dark ELSE Square = Light
|
|
IF Board(Row1, Col1) \ 10 = 0 THEN Colr = Black ELSE Colr = White
|
|
|
|
x = Col1 * 50 - 19
|
|
y = Row1 * 50 - 19
|
|
HideMOUSE
|
|
PUT (x, y), Box(Cancel), PSET
|
|
ShowMOUSE
|
|
|
|
Board(Row2, Col2) = Board(Row1, Col1)
|
|
Board(Row1, Col1) = 0
|
|
|
|
x = Col2 * 50 - 19
|
|
y = Row2 * 50 - 19
|
|
HideMOUSE
|
|
PUT (x, y), Box(Colr + Piece + Square), PSET
|
|
ShowMOUSE
|
|
ELSE
|
|
HighLIGHT Row1, Col1, 0
|
|
END IF
|
|
|
|
END SUB
|
|
|
|
SUB SetPALETTE
|
|
|
|
RESTORE PaletteDATA
|
|
OUT &H3C8, 0
|
|
FOR n = 1 TO 48
|
|
READ Intensity
|
|
OUT &H3C9, Intensity
|
|
NEXT n
|
|
|
|
END SUB
|
|
|
|
SUB ShowMOUSE
|
|
LB = 1
|
|
MouseDRIVER LB, 0, 0, 0
|
|
END SUB
|
|
|
|
SUB ABSOLUTE_MOUSE_EMU (AX%, BX%, CX%, DX%)
|
|
SELECT CASE AX%
|
|
CASE 0
|
|
AX% = -1
|
|
CASE 1
|
|
_MOUSESHOW
|
|
CASE 2
|
|
_MOUSEHIDE
|
|
CASE 3
|
|
WHILE _MOUSEINPUT
|
|
WEND
|
|
BX% = -_MOUSEBUTTON(1) - _MOUSEBUTTON(2) * 2 - _MOUSEBUTTON(3) * 4
|
|
CX% = _MOUSEX
|
|
DX% = _MOUSEY
|
|
CASE 4
|
|
_MOUSEMOVE CX%, DX% 'Not currently supported in QB64 GL
|
|
END SELECT
|
|
END SUB
|