+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Prolific Programmers (https://staging.qb64phoenix.com/forumdisplay.php?fid=26)
+---- Forum: TheBOB (https://staging.qb64phoenix.com/forumdisplay.php?fid=27)
+---- Thread: Discussion Board for the Collection of Graphic Programs by TheBOB. (/showthread.php?tid=55)
Discussion Board for the Collection of Graphic Programs by TheBOB. - Pete - 04-19-2022
RE: Preview of Coming Attractions - johnno56 - 04-20-2022
(04-19-2022, 05:53 PM)Pete Wrote: KONG2.BAS
Code: (Select All)'****************************************************************************'
'____________________________________________________________________________
'____________________________________________________________________________'
'_____²²___²²__²²²²²__²²___²²__²²²²²____________²²___²²___²²²²___²²__²²______'
'_____²²___²²_²²___²²_²²___²²_²²___²²___________²²___²²____²²____²²__²²______'
'_____²²__²²__²²___²²_²²²__²²_²²___²²___________²²²_²²²____²²____²²__²²______'
'_____²²_²²___²²___²²_²²²__²²_²²_______²_²_²_²__²²²_²²²____²²____²²__²²______'
'_____²²²²____²²___²²_²²²²_²²_²²_______²_²_²____²²²²²²²____²²____²²__²²______'
'_____°°°°____°°___°°_°°_°°°°_°°_______°_°___°__°°_°_°°____°°_____°°°°_______'
'_____°°_°°___°°___°°_°°__°°°_°°__°°°___°__°_°__°°_°_°°____°°______°°________'
'_____°°__°°__°°___°°_°°__°°°_°°___°°___________°°_°_°°_°°_°°______°°________'
'_____°°___°°_°°___°°_°°___°°_°°___°°___________°°___°°_°°_°°______°°________'
'_____°°___°°__°°°°°__°°___°°__°°°°°____________°°___°°__°°°______°°°°_______'
' '
'----------- Microsoft QBasic originally came bundled with four -------------'
'----------- example programs: a simple money management program ------------'
'----------- called, appropriately, "Money", a utility for removing ---------'
'----------- line numbers from BASIC programs called "RemLine", and ---------'
'----------- two game programs, "Nibbles" and "Gorilla". In the case --------'
'----------- of the second game, I loved the idea of two gorillas -----------'
'----------- throwing exploding bananas at each other from the roof- --------'
'----------- tops and had always wanted to do my own version. Here ----------'
'----------- then, is my homage to the QBasic classic, GORILLA.BAS... -------'
'
'-------------------- ...KING-KONG vs MIGHTY JOE YOUNG ----------------------'
'------- (Freeware)--Unique elements Copyright (C) 2005 by Bob Seguin -------'
DEFINT A-Z
CONST Degree! = 3.14159 / 180
CONST g# = 9.8
REDIM SHARED Box(1 TO 26000)
REDIM SHARED KongBOX(1 TO 5500)
REDIM SHARED YoungBOX(1 TO 5500)
DIM SHARED ExplosionBACK(1200)
DIM SHARED SliderBOX(1 TO 440)
DIM SHARED Banana(1 TO 900)
DIM SHARED FadeBOX(1 TO 48)
DIM SHARED LilBOX(1 TO 120)
DIM SHARED Buildings(1 TO 8, 1 TO 2)
DIM SHARED NumBOX(1 TO 300)
DEF SEG = VARSEG(NumBOX(1))
BLOAD "KongNUMS.BSV", VARPTR(NumBOX(1))
DEF SEG = VARSEG(LilBOX(1))
BLOAD "KongWIND.BSV", VARPTR(LilBOX(1))
DEF SEG = VARSEG(Banana(1))
BLOAD "KongBNNA.BSV", VARPTR(Banana(1))
DEF SEG = VARSEG(SliderBOX(1))
BLOAD "KongSLDR.BSV", VARPTR(SliderBOX(1))
DEF SEG
FOR n = 1 TO 8
Buildings(n, 1) = n
NEXT n
DIM SHARED LB, RB, MouseX, MouseY
DIM SHARED x#, y#, Angle#, Speed#, Wind!, t#
DIM SHARED KongX, KongY, YoungX, YoungY, Ape
DIM SHARED KScore, YScore, Item, LBldg, RBldg
DIM SHARED NumPLAYERS, CompTOSS
RESTORE PaletteDATA
FOR n = 1 TO 48
READ FadeBOX(n)
NEXT n
SCREEN 12
_FULLSCREEN
OUT &H3C8, 0
FOR n = 1 TO 48
OUT &H3C9, 0
NEXT n
RANDOMIZE TIMER
DO
PlayGAME
LOOP
END
PaletteDATA:
DATA 0,4,16,0,10,21,0,16,32,32,10,0
DATA 63,0,0,63,32,0,18,18,24,30,30,37
DATA 42,42,50,55,55,63,0,0,0,43,27,20
DATA 8,8,21,0,63,21,63,55,25,63,63,63
SUB ApeCHUCKLE (Which)
IF Which = 1 THEN
LaffX! = (KongX / 320) - 1
ELSE
LaffX! = (YoungX / 320) - 1
END IF
IF LaffX! < -1 THEN LaffX! = -1
IF LaffX! > 1 THEN LaffX! = 1
Laff& = _SNDOPEN("KONGlaff.ogg", "SYNC,VOL")
REM _SNDBAL Laff&, LaffX!
_SNDPLAY Laff&
SELECT CASE Which
CASE 1 'Kong chuckle
FOR Reps = 1 TO 10
WAIT &H3DA, 8
WAIT &H3DA, 8, 8
PUT (KongX, KongY), KongBOX(1351), PSET
Interval .1
WAIT &H3DA, 8
WAIT &H3DA, 8, 8
PUT (KongX, KongY), KongBOX(1801), PSET
Interval .1
NEXT Reps
CASE 2 'Young chuckle
FOR Reps = 1 TO 10
WAIT &H3DA, 8
WAIT &H3DA, 8, 8
PUT (YoungX, YoungY), YoungBOX(1351), PSET
Interval .1
WAIT &H3DA, 8
WAIT &H3DA, 8, 8
PUT (YoungX, YoungY), YoungBOX(1801), PSET
Interval .1
NEXT Reps
END SELECT
END SUB
FUNCTION BananaTOSS 'tosses banana
SHARED BananaHIT
t# = 0
IF Ape = 1 THEN
YTurn = 0: KTurn = 7
x# = KongX: y# = KongY - 24
ELSE
KTurn = 7: KTurn = 0
x# = YoungX: y# = YoungY - 24
END IF
IF Ape = 2 THEN Angle# = 180 - Angle#
Angle# = Angle# * Degree!
vx# = Speed# * COS(Angle#)
vy# = Speed# * SIN(Angle#)
InitialX = x#
InitialY = y#
'GET starting background location of banana ---------------------------
GET (x#, y#)-(x# + 12, y# + 12), Banana(801)
'Animate banana toss (frames 2 & 3) -----------------------------------
FOR Index = 451 TO 901 STEP 450
Interval .02
WAIT &H3DA, 8
WAIT &H3DA, 8, 8
IF Ape = 1 THEN
PUT (KongX, KongY), KongBOX(Index), PSET
ELSE
PUT (YoungX, YoungY), YoungBOX(Index), PSET
END IF
NEXT Index
Index = 1 'Initialize banana index
_SNDPLAYFILE "KONGbnna.ogg", 1
DO 'banana toss loop
Interval .001
WAIT &H3DA, 8
WAIT &H3DA, 8, 8
'PUT banana background at old x/y ---------------------------
IF x# >= 0 AND x# <= 627 THEN
IF y# >= 40 THEN
PUT (x#, y#), Banana(801), PSET
END IF
END IF
'Determine new position of banana --------------------------
'NOTE: The essential formula for determining the path of
'the thrown banana is taken from the original GORILLA.BAS
x# = InitialX + (vx# * t#) + (.5 * (Wind! / 5) * t# ^ 2)
y# = InitialY + -(vy# * t#) + (.5 * g# * t# ^ 2)
t# = t# + .1
'Whether or not to PUT the banana and background
IF x# >= 2 AND x# < 627 THEN
IF y# >= 40 AND y# <= 467 THEN
'JOE YOUNG hit
IF x# + 12 >= YoungX + 2 AND x# <= YoungX + 38 THEN
IF y# + 12 >= YoungY + 7 AND y# <= YoungY + 42 THEN
Explode 2
KScore = KScore + 1
PrintSCORE 1, KScore
ApeCHUCKLE 1
BananaTOSS = 1
EXIT FUNCTION
END IF
END IF
'KONG is hit
IF x# + 12 >= KongX + 2 AND x# <= KongX + 38 THEN
IF y# + 12 >= KongY + 7 AND y# <= KongY + 42 THEN
Explode 1
YScore = YScore + 1
PrintSCORE 2, YScore
ApeCHUCKLE 2
BananaTOSS = 2
EXIT FUNCTION
END IF
END IF
'Building hit
IF y# > 120 THEN
IF (POINT(x# + 2, y#) <> 12 AND POINT(x# + 2, y#) <> 0) THEN BLDG = 1
IF (POINT(x# + 10, y#) <> 12 AND POINT(x# + 10, y#) <> 0) THEN BLDG = 1
IF (POINT(x#, y# + 10) <> 12 AND POINT(x#, y# + 10) <> 0) THEN BLDG = 1
END IF
IF BLDG = 1 THEN
BLDG = 0
Explode 3
BananaTOSS = 3
EXIT FUNCTION
END IF
'GET background, PUT banana at new location
GET (x#, y#)-(x# + 12, y# + 12), Banana(801)
PUT (x#, y#), Banana(Index + 50), AND
PUT (x#, y#), Banana(Index)
END IF 'Legal banana-PUT END IF's
END IF
Index = Index + 100 'Index changes whether banana is PUT or not ---------
IF Index = 801 THEN Index = 1
'Ape reaction turns section -----------------------------------------------
IF t# > .5 AND t# < .6 THEN 'Finish toss (arm goes down)
IF Ape = 1 THEN
PUT (KongX, KongY), KongBOX(4501), PSET
ELSE
PUT (YoungX, YoungY), YoungBOX(2701), PSET
END IF
END IF
IF t# > 1.5 THEN 'Turn with passing banana (both apes)
IF YTurn < 2 THEN
WAIT &H3DA, 8
WAIT &H3DA, 8, 8
SELECT CASE YTurn
CASE 0: PUT (YoungX, YoungY), YoungBOX(3151), PSET: YTurn = 1
CASE 1: PUT (YoungX, YoungY), YoungBOX(2701), PSET: YTurn = 2
END SELECT
END IF
IF KTurn < 2 THEN
WAIT &H3DA, 8
WAIT &H3DA, 8, 8
SELECT CASE KTurn
CASE 0: PUT (KongX, KongY), KongBOX(4051), PSET: KTurn = 1
CASE 1: PUT (KongX, KongY), KongBOX(4501), PSET: KTurn = 2
END SELECT
END IF
IF x# > YoungX AND YTurn < 7 THEN
WAIT &H3DA, 8
WAIT &H3DA, 8, 8
SELECT CASE YTurn
CASE 2: PUT (YoungX, YoungY), YoungBOX(2701), PSET: YTurn = 3
CASE 3: PUT (YoungX, YoungY), YoungBOX(3151), PSET: YTurn = 4
CASE 4: PUT (YoungX, YoungY), YoungBOX(3601), PSET: YTurn = 5
CASE 5: PUT (YoungX, YoungY), YoungBOX(4051), PSET: YTurn = 6
CASE 6: PUT (YoungX, YoungY), YoungBOX(4501), PSET: YTurn = 7
END SELECT
END IF
IF x# < KongX + 40 AND KTurn < 7 THEN
WAIT &H3DA, 8
WAIT &H3DA, 8, 8
SELECT CASE KTurn
CASE 2: PUT (KongX, KongY), KongBOX(4501), PSET: KTurn = 3
CASE 3: PUT (KongX, KongY), KongBOX(4051), PSET: KTurn = 4
CASE 4: PUT (KongX, KongY), KongBOX(3601), PSET: KTurn = 5
CASE 5: PUT (KongX, KongY), KongBOX(3151), PSET: KTurn = 6
CASE 6: PUT (KongX, KongY), KongBOX(2701), PSET: KTurn = 7
END SELECT
END IF
END IF
LOOP UNTIL x# < 3 OR x# > 627
Explode 4
IF x# >= 0 AND x# <= 627 THEN 'erase banana to end toss sequence -------
IF y# >= 40 THEN
PUT (x#, y#), Banana(801), PSET
END IF
END IF
BananaTOSS = 3
END FUNCTION
SUB ClearMOUSE
WHILE LB OR RB
MouseSTATUS LB, RB, MouseX, MouseY
WEND
END SUB
FUNCTION Computer
STATIC CompSPEED, CompANGLE, XDiff, YDiff, FinalX
'The computer's gameplay is designed to imitate the play of a
'real person. The first shot is established as an educated guess
'with a touch of randomness. On subsequent shots, the formula
'modifies Speed# and Angle# based on the outcome of this first shot.
'Sometimes, just like a real person, the first shot will score a
'hit. Other times, it is a long and embarassing process.
'Computer-shot computation formulas
IF CompTOSS = 0 THEN
XDiff = YoungX - KongX
YDiff = KongY - YoungY
CompSPEED = XDiff / (FIX(RND * 2) + 6) + Wind!
CompANGLE = 35 - (YDiff / 5)
CompTOSS = 1
ELSE
IF KongX > FinalX THEN
CompSPEED = CompSPEED * .9
ELSE
CompSPEED = CompSPEED * 1.12
IF YoungX - FinalX < 100 THEN 'Oops! Tall building
CompANGLE = CompANGLE + 10
ELSE
CompANGLE = CompANGLE + 3
END IF
END IF
END IF
IF CompSPEED > 99 THEN CompSPEED = 99
IF CompSPEED < 0 THEN CompSPEED = 0
IF CompANGLE > 70 THEN CompANGLE = 70
IF CompANGLE < 0 THEN CompANGLE = 0
Speed# = CompSPEED
Angle# = CompANGLE
Sliders INT(Speed#), 1
Sliders INT(Angle#), 2
Interval 1
SELECT CASE BananaTOSS 'Call to BananaTOSS FUNCTION -----------
CASE 1 'Kong exploded Young
IF KScore = 3 THEN 'Kong wins
Computer = 2 'Game over
EXIT FUNCTION
END IF
Computer = 1 'Reset screen
EXIT FUNCTION
CASE 2 'Young exploded Kong
IF YScore = 3 THEN 'Young wins
Computer = 2 'Game over
EXIT FUNCTION
END IF
Computer = 1 'Reset screen
EXIT FUNCTION
CASE 3 'Building explosion or banana out-of-play
FinalX = x#
Computer = -1 'Change player
EXIT FUNCTION
END SELECT
Computer = 0 'No action required
END FUNCTION
FUNCTION ControlPANEL
SHARED Player1SPEED#, Player2SPEED#
SHARED Player1ANGLE#, Player2ANGLE#
SELECT CASE MouseX
CASE 147 TO 246
IF MouseY > 441 AND MouseY < 463 THEN
IF LB = -1 THEN
Speed# = MouseX - 147
IF Speed# < 0 THEN Speed# = 0
IF Speed# > 99 THEN Speed# = 99
SELECT CASE Ape
CASE 1
Player1SPEED# = Speed#
CASE 2
Player2SPEED# = Speed#
END SELECT
Sp = INT(Speed#)
Sliders Sp, 1
END IF
END IF
CASE 385 TO 499
IF MouseY > 423 AND MouseY < 463 THEN
IF LB = -1 THEN
Angle# = 494 - MouseX
IF Angle# < 0 THEN Angle# = 0
IF Angle# > 90 THEN Angle# = 90
SELECT CASE Ape
CASE 1
Player1ANGLE# = Angle#
CASE 2
Player2ANGLE# = Angle#
END SELECT
An = INT(Angle#)
Sliders An, 2
END IF
END IF
CASE 305 TO 335
IF MouseY > 423 AND MouseY < 452 THEN
IF LB = -1 THEN
HideMOUSE
GET (308, 427)-(331, 447), Box(25500)
GET (311, 430)-(328, 444), Box(25000)
PUT (310, 429), Box(25000), PSET
LINE (309, 428)-(330, 446), 1, B
LINE (308, 428)-(331, 448), 10, B
LINE (331, 429)-(331, 447), 8
LINE (308, 448)-(330, 448), 8
ShowMOUSE
Interval .2
HideMOUSE
PUT (308, 427), Box(25500), PSET
ShowMOUSE
SELECT CASE BananaTOSS 'Call to BananaTOSS FUNCTION -----------
CASE 1 'Kong exploded Young
IF KScore = 3 THEN 'Kong wins
ControlPANEL = 2 'Game over
EXIT FUNCTION
END IF
ControlPANEL = 1 'Reset screen
EXIT FUNCTION
CASE 2 'Young exploded Kong
IF YScore = 3 THEN 'Young wins
ControlPANEL = 2 'Game over
EXIT FUNCTION
END IF
ControlPANEL = 1 'Reset screen
EXIT FUNCTION
CASE 3 'Building explosion or banana out-of-play
ControlPANEL = -1 'Change player
EXIT FUNCTION
END SELECT
END IF
END IF
END SELECT
ControlPANEL = 0 'No action required
END FUNCTION
SUB DoAPES
KongX = LBldg * 80 - 59
KongY = Buildings(LBldg, 2) - 42
YoungX = RBldg * 80 - 59
YoungY = Buildings(RBldg, 2) - 42
DEF SEG = VARSEG(Box(1))
BLOAD "KongMJY.BSV", VARPTR(Box(1))
DEF SEG
ApeINDEX = 1
GET (YoungX, YoungY)-(YoungX + 38, YoungY + 42), YoungBOX(5000)
FOR Index = 1 TO 9001 STEP 900
PUT (YoungX, YoungY), YoungBOX(5000), PSET
PUT (YoungX, YoungY), Box(Index + 450), AND
PUT (YoungX, YoungY), Box(Index)
GET (YoungX, YoungY)-(YoungX + 38, YoungY + 42), YoungBOX(ApeINDEX)
ApeINDEX = ApeINDEX + 450
NEXT Index
DEF SEG = VARSEG(Box(1))
BLOAD "KongKONG.BSV", VARPTR(Box(1))
DEF SEG
ApeINDEX = 1
GET (KongX, KongY)-(KongX + 38, KongY + 42), KongBOX(5000)
FOR Index = 1 TO 9001 STEP 900
PUT (KongX, KongY), KongBOX(5000), PSET
PUT (KongX, KongY), Box(Index + 450), AND
PUT (KongX, KongY), Box(Index)
GET (KongX, KongY)-(KongX + 38, KongY + 42), KongBOX(ApeINDEX)
ApeINDEX = ApeINDEX + 450
NEXT Index
PUT (KongX, KongY), KongBOX(2251), PSET
PUT (YoungX, YoungY), YoungBOX(2251), PSET
DEF SEG = VARSEG(Box(1))
BLOAD "KongEXPL.BSV", VARPTR(Box(1))
DEF SEG
END SUB
SUB DrawSCREEN
'Main screen background/title bar and control panel
CLS
DEF SEG = VARSEG(Box(1))
FileCOUNT = 0
FOR y = 0 TO 320 STEP 160
FileCOUNT = FileCOUNT + 1
FileNAME$ = "KongSCR" + LTRIM$(STR$(FileCOUNT)) + ".BSV"
BLOAD FileNAME$, VARPTR(Box(1))
PUT (0, y), Box(), PSET
NEXT y
DEF SEG
'Shuffle buildings order
FOR n = 8 TO 2 STEP -1
Tower = INT(RND * n) + 1
SWAP Buildings(n, 1), Buildings(Tower, 1)
NEXT n
LBldg = FIX(RND * 3) + 1
RBldg = FIX(RND * 3) + 6
'Set buildings order/ save height information to array
x = 0
DEF SEG = VARSEG(Box(1))
FOR n = 1 TO 8
FileNAME$ = "KongBLD" + LTRIM$(STR$(Buildings(n, 1))) + ".BSV"
BLOAD FileNAME$, VARPTR(Box(1))
Height = 165 + FIX(RND * 160)
IF n = LBldg AND Height > 264 THEN Height = 264
IF n = RBldg AND Height > 264 THEN Height = 264
Buildings(n, 2) = Height
Box(2001) = 405 - (Height + Box(1))
PUT (x, Height + Box(1)), Box(2000), PSET
PUT (x, Height + Box(1) - 45), Box(1000), AND
PUT (x, Height + Box(1) - 45), Box(2)
x = x + 80
NEXT n
'Street lights
FOR x = 19 TO 639 STEP 120
LINE (x, 360)-(x + 1, 400), 10, B
CIRCLE (x + 8, 364), 2, 15
PAINT STEP(0, 0), 15
CIRCLE STEP(0, 0), 5, 8
NEXT x
'Foreground building silhouettes
BLOAD "KongFBLD.BSV", VARPTR(Box(1))
DEF SEG
PUT (0, 362), Box(7000), AND
PUT (0, 362), Box()
SetWIND
Sliders 0, 1
Sliders 0, 2
PrintSCORE 1, KScore
PrintSCORE 2, YScore
END SUB
SUB Explode (What)
STATIC BlastCOUNT
BlastX! = (x# / 320) - 1
IF BlastX! < -1 THEN BlastX! = -1
IF BlastX! > 1 THEN BlastX! = 1
b1& = _SNDOPEN("KONGExp1.ogg", "SYNC,VOL")
b2& = _SNDOPEN("KONGExp2.ogg", "SYNC,VOL")
b3& = _SNDOPEN("KONGExp3.ogg", "SYNC,VOL")
SELECT CASE What
CASE 1 'Kong hit
REM _SNDBAL b2&, BlastX!
_SNDPLAY b2&
Ex = x# - 26: Ey = y# - 26
GOSUB FirstBLAST
Ex = KongX - 12: Ey = KongY - 12
Dx = KongX - 4: Dy = KongY + 20
CASE 2 'Young hit
REM _SNDBAL b2&, BlastX!
_SNDPLAY b2&
Ex = x# - 26: Ey = y# - 26
GOSUB FirstBLAST
Ex = YoungX - 12: Ey = YoungY - 12
Dx = YoungX - 4: Dy = YoungY + 20
CASE 3 'Building hit
REM _SNDBAL b3&, BlastX!
_SNDPLAY b3&
Ex = x# - 26: Ey = y# - 26
Dx = x# - 20: Dy = y# - 20
CASE 4 'Off-screen explosion
REM _SNDBAL b1&, BlastX!
_SNDPLAY b1&
EXIT SUB
END SELECT
IF Ex + 62 > 639 THEN Ex = 639 - 62
IF Ex < 0 THEN Ex = 0
GET (Ex, Ey)-(Ex + 62, Ey + 62), ExplosionBACK()
FOR Index = 1 TO 14421 STEP 2060
PUT (Ex, Ey), ExplosionBACK(), PSET
IF Index = 4121 THEN
IF What = 1 THEN
PUT (KongX, KongY), KongBOX(5000), PSET
ELSEIF What = 2 THEN
PUT (YoungX, YoungY), YoungBOX(5000), PSET
END IF
GOSUB Damage
GET (Ex, Ey)-(Ex + 62, Ey + 62), ExplosionBACK()
END IF
PUT (Ex, Ey), Box(Index + 1030), AND
PUT (Ex, Ey), Box(Index), XOR
Interval .05
WAIT &H3DA, 8
WAIT &H3DA, 8, 8
NEXT Index
PUT (Ex, Ey), ExplosionBACK(), PSET
EXIT SUB
Damage:
OPEN "KongCRTR.DAT" FOR INPUT AS #2
INPUT #2, Wdth, Dpth
BlastCOUNT = BlastCOUNT + 1
SELECT CASE BlastCOUNT
CASE 1
FOR cx = Dx + Wdth TO Dx STEP -1
FOR cy = Dy + Dpth TO Dy STEP -1
GOSUB DrawCRATER
NEXT cy
NEXT cx
CASE 2
FOR cx = Dx TO Dx + Wdth
FOR cy = Dy TO Dy + Dpth
GOSUB DrawCRATER
NEXT cy
NEXT cx
BlastCOUNT = 0
END SELECT
CLOSE #2
RETURN
DrawCRATER:
INPUT #2, Colr
IF Colr <> 0 THEN
IF POINT(cx, cy) <> 0 AND POINT(cx, cy) <> 12 THEN
PSET (cx, cy), Colr
END IF
END IF
RETURN
FirstBLAST:
IF Ex < 0 THEN Ex = 0
IF Ex + 62 > 639 THEN Ex = 577
GET (Ex, Ey)-(Ex + 62, Ey + 62), ExplosionBACK()
_SNDPLAYFILE "Explosion.ogg"
FOR Index = 1 TO 6181 STEP 2060
Interval 0
WAIT &H3DA, 8
WAIT &H3DA, 8, 8
PUT (Ex, Ey), ExplosionBACK(), PSET
PUT (Ex, Ey), Box(Index + 1030), AND
PUT (Ex, Ey), Box(Index), XOR
NEXT Index
PUT (Ex, Ey), ExplosionBACK(), PSET
RETURN
END SUB
SUB Fade (InOUT)
IF InOUT = 1 THEN 'Fade out
FullFADE! = 1
DO
Interval .1
WAIT &H3DA, 8
WAIT &H3DA, 8, 8
FullFADE! = FullFADE! * 1.3
OUT &H3C8, 0
FOR n = 1 TO 48
OUT &H3C9, INT(FadeBOX(n) / FullFADE!)
NEXT n
LOOP WHILE FullFADE! < 20
OUT &H3C8, 0
FOR n = 1 TO 48
OUT &H3C9, 0
NEXT n
ELSE 'Fade in
FullFADE! = 20
DO
Interval .1
WAIT &H3DA, 8
WAIT &H3DA, 8, 8
FullFADE! = FullFADE! * .825
OUT &H3C8, 0
FOR n = 1 TO 48
OUT &H3C9, INT(FadeBOX(n) / FullFADE!)
NEXT n
LOOP WHILE FullFADE! > 1.2
SetPALETTE
END IF
END SUB
SUB HideMOUSE
_MOUSEHIDE: MouseDRIVER
END SUB
SUB Instructions
HideMOUSE
GET (192, 140)-(447, 290), Box(12000)
ShowMOUSE
FOR n = 1 TO 3
DEF SEG = VARSEG(Box(1))
FileNAME$ = "KongINS" + LTRIM$(STR$(n)) + ".BSV"
BLOAD FileNAME$, VARPTR(Box(1))
DEF SEG
HideMOUSE
PUT (192, 140), Box(), PSET
ShowMOUSE
GOSUB ClickARROW
NEXT n
HideMOUSE
PUT (192, 140), Box(12000), PSET
ShowMOUSE
DEF SEG = VARSEG(Box(1))
BLOAD "KongEXPL.BSV", VARPTR(Box(1))
DEF SEG
EXIT SUB
ClickARROW:
DO
MouseSTATUS LB, RB, MouseX, MouseY
SELECT CASE MouseX
CASE 400 TO 424
IF MouseY > 154 AND MouseY < 168 THEN
IF Arrow = 0 THEN
HideMOUSE
GET (400, 154)-(424, 167), Box(25000)
FOR x = 400 TO 424
FOR y = 154 TO 167
IF POINT(x, y) = 6 THEN PSET (x, y), 13
NEXT y
NEXT x
ShowMOUSE
Arrow = 1
END IF
ELSE
IF Arrow THEN
HideMOUSE
PUT (400, 154), Box(25000), PSET
ShowMOUSE
Arrow = 0
END IF
END IF
CASE ELSE
IF Arrow THEN
HideMOUSE
PUT (400, 154), Box(25000), PSET
ShowMOUSE
Arrow = 0
END IF
END SELECT
IF Arrow = 1 AND LB = -1 THEN
_SNDPLAYFILE "KONGtick.ogg", 1
PUT (400, 154), Box(25000), PSET
ClearMOUSE
Arrow = 0
RETURN
END IF
LOOP
RETURN
END SUB
DEFSNG A-Z
SUB Interval (Length!)
OldTIMER# = TIMER
DO
IF TIMER < OldTIMER# THEN EXIT SUB
LOOP UNTIL TIMER > OldTIMER# + Length!
WAIT &H3DA, 8
END SUB
DEFINT A-Z
SUB MouseDRIVER
WHILE _MOUSEINPUT: WEND
END SUB
SUB MouseSTATUS (LB, RB, MouseX, MouseY)
MouseDRIVER
LB = _MOUSEBUTTON(1)
RB = _MOUSEBUTTON(2)
MouseX = _MOUSEX
MouseY = _MOUSEY
END SUB
SUB PauseMOUSE (OldLB, OldRB, OldMX, OldMY)
SHARED Key$
DO
_LIMIT 60
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 PlayGAME
STATIC Started, Counnt
SHARED Player1SPEED#, Player2SPEED#
SHARED Player1ANGLE#, Player2ANGLE#
DrawSCREEN
DoAPES
CompTOSS = 0
IF Started = 0 THEN
Street& = _SNDOPEN("Kongstam.ogg", "SYNC")
_SNDPLAYFILE "Kong theme.ogg", 1
_SNDLOOP Street&
END IF
Fade 2
DO
IF Started = 0 THEN
KScore = 0: YScore = 0
PrintSCORE 1, KScore
PrintSCORE 2, YScore
StartUP
Started = 1
IF NumPLAYERS = 2 THEN
Ape = FIX(RND * 2) + 1
Player1SPEED# = 0: Player2SPEED# = 0
Player1ANGLE# = 0: Player2ANGLE# = 0
ELSE
Ape = 2
END IF
ClearMOUSE
END IF
IF Ape = 1 THEN Ape = 2 ELSE Ape = 1
IF Ape = 1 THEN
YTurn = 0: KTurn = 7
LINE (73, 473)-(97, 474), 13, B 'LED's
LINE (540, 473)-(564, 474), 10, B
PUT (KongX, KongY), KongBOX(), PSET
Speed# = Player1SPEED#: Angle# = Player1ANGLE#
Sliders INT(Player1SPEED#), 1
Sliders INT(Player1ANGLE#), 0
ELSE
YTurn = 7: KTurn = 0
LINE (73, 473)-(97, 474), 10, B 'LED's
LINE (540, 473)-(564, 474), 13, B
PUT (YoungX, YoungY), YoungBOX(), PSET
Speed# = Player2SPEED#: Angle# = Player2ANGLE#
Sliders INT(Player2SPEED#), 1
Sliders INT(Player2ANGLE#), 0
END IF
ShowMOUSE
DO
IF NumPLAYERS = 1 AND Ape = 2 THEN
SELECT CASE Computer 'Call to Computer FUNCTION
CASE -1: EXIT DO 'Change player
CASE 1 'Reset screen
Fade 1
HideMOUSE
Player1SPEED# = 0: Player2SPEED# = 0
Player1ANGLE# = 0: Player2ANGLE# = 0
EXIT SUB
CASE 2: GOSUB EndGAME 'Game over
END SELECT
ELSE
MouseSTATUS LB, RB, MouseX, MouseY
SELECT CASE MouseY
CASE 18 TO 27
TopMENU 1
CASE 424 TO 462
SELECT CASE ControlPANEL 'Call to ControlPANEL FUNCTION
CASE -1: EXIT DO 'Change player
CASE 1 'Reset screen
Fade 1
HideMOUSE
Player1SPEED# = 0: Player2SPEED# = 0
Player1ANGLE# = 0: Player2ANGLE# = 0
EXIT SUB
CASE 2: GOSUB EndGAME 'Game over
END SELECT
CASE ELSE
IF Item THEN TopMENU 0
END SELECT
END IF
Counnt = Counnt + 1
IF Counnt = 32000 THEN Counnt = 0
IF INT(RND * 10000) = 0 THEN
IF INT(RND * 600) = 0 THEN
SELECT CASE Counnt MOD 3
CASE 0: _SNDPLAYFILE "KONGhrn1.ogg", 1
CASE 1: _SNDPLAYFILE "KONGhrn2.ogg", 1
CASE 2: _SNDPLAYFILE "KONGcar.ogg", 1
END SELECT
END IF
END IF
LOOP
LOOP
EXIT SUB
EndGAME:
_SNDPLAYFILE "KONGvict.ogg", 1
DEF SEG = VARSEG(Box(1))
IF KScore = 3 THEN
BLOAD "KongWINK.BSV", VARPTR(Box(1))
ELSE
BLOAD "KongWINY.BSV", VARPTR(Box(1))
END IF
DEF SEG
wx = (640 - Box(1)) / 2
WAIT &H3DA, 8
WAIT &H3DA, 8, 8
PUT (wx, 160), Box(), PSET
_SNDSTOP Street&
a$ = INPUT$(1)
IF a$ = CHR$(13) THEN
Started = 0
Fade 1
Player1SPEED# = 0: Player2SPEED# = 0
Player1ANGLE# = 0: Player2ANGLE# = 0
HideMOUSE
EXIT SUB
END IF
SYSTEM
RETURN
END SUB
SUB PrintSCORE (Ape, Score)
IF Ape = 1 THEN
PUT (19, 452), NumBOX(Score * 75 + 1), PSET
ELSE
PUT (604, 452), NumBOX(Score * 75 + 1), PSET
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 SetWIND
Wind! = FIX(RND * 17) - 8
LINE (291, 462)-(349, 476), 7, BF
IF Wind! = 0 THEN
PUT (298, 465), LilBOX(), PSET
ELSE
IF Wind! < 0 THEN
PSET (320 + ABS(Wind! * 2) + 3, 466), 13
DRAW "L10"
DRAW "L" + LTRIM$(STR$(ABS(Wind! * 3))) + "U3 G6 F6 U3 R10"
DRAW "R" + LTRIM$(STR$(ABS(Wind! * 3))) + "U6 bg3 p13,13"
ELSE
PSET (320 - Wind! * 2 - 3, 466), 13
DRAW "R10"
DRAW "R" + LTRIM$(STR$(ABS(Wind! * 3))) + "U3 F6 G6 U3 L10"
DRAW "L" + LTRIM$(STR$(ABS(Wind! * 3))) + "U6 bf3 p13,13"
END IF
END IF
END SUB
SUB ShowMOUSE
_MOUSESHOW: MouseDRIVER
END SUB
SUB Sliders (Value, Slider)
STATIC LeftX, RightX
IF LeftX = 0 THEN LeftX = 141
IF RightX = 0 THEN RightX = 484
WAIT &H3DA, 8
WAIT &H3DA, 8, 8
HideMOUSE
IF Slider = 1 THEN
PUT (LeftX, 443), SliderBOX(281), PSET
LeftX = 141 + Value
GET (LeftX, 443)-(LeftX + 10, 461), SliderBOX(281)
PUT (LeftX, 443), SliderBOX(201), PSET
ELSE
PUT (RightX, 443), SliderBOX(361), PSET
RightX = 489 - Value
GET (RightX, 443)-(RightX + 10, 461), SliderBOX(361)
PUT (RightX, 443), SliderBOX(201), PSET
END IF
ShowMOUSE
GOSUB SetNUMS
EXIT SUB
SetNUMS:
Num$ = LTRIM$(STR$(Value))
IF Value < 10 THEN
LNum = 0
RNum = VAL(Num$)
ELSE
LNum = VAL(MID$(Num$, 1, 1))
RNum = VAL(MID$(Num$, 2, 1))
END IF
HideMOUSE
IF Slider = 1 THEN
PUT (260, 447), SliderBOX(LNum * 20 + 1), PSET
PUT (266, 447), SliderBOX(RNum * 20 + 1), PSET
ELSE
PUT (369, 447), SliderBOX(LNum * 20 + 1), PSET
PUT (375, 447), SliderBOX(RNum * 20 + 1), PSET
END IF
ShowMOUSE
RETURN
END SUB
SUB StartUP
DEF SEG = VARSEG(Box(1))
BLOAD "Kong1PL2.BSV", VARPTR(Box(1))
DEF SEG
GET (209, 160)-(430, 237), Box(12000)
PUT (209, 160), Box(), PSET
ShowMOUSE
DO
MouseSTATUS LB, RB, MouseX, MouseY
SELECT CASE MouseX
CASE 244 TO 270
IF Item = 0 THEN
SELECT CASE MouseY
CASE 193 TO 205
IF LB THEN
ButtonX = 245: ButtonY = 194
GOSUB Clicker
NumPLAYERS = 2
FileNAME$ = "KongOPEN.BSV"
GOSUB LoadFILE
END IF
CASE 209 TO 221
IF LB THEN
ButtonX = 245: ButtonY = 210
GOSUB Clicker
NumPLAYERS = 1
FileNAME$ = "Kong1PLR.BSV"
GOSUB LoadFILE
END IF
END SELECT
END IF
CASE 340 TO 366
IF Item = 1 THEN
IF MouseY > 209 AND MouseY < 221 THEN
IF LB THEN
ButtonX = 340: ButtonY = 210
GOSUB Clicker
EXIT DO
END IF
END IF
END IF
END SELECT
LOOP
HideMOUSE
PUT (209, 160), Box(12000), PSET
ShowMOUSE
Item = 0
DEF SEG = VARSEG(Box(1))
BLOAD "KongEXPL.BSV", VARPTR(Box(1))
DEF SEG
EXIT SUB
LoadFILE:
DEF SEG = VARSEG(Box(1))
BLOAD FileNAME$, VARPTR(Box(21500))
DEF SEG
HideMOUSE
PUT (209, 160), Box(21500), PSET
ShowMOUSE
RETURN
Clicker:
_SNDPLAYFILE "KONGtick.ogg", 1
HideMOUSE
GET (ButtonX, ButtonY)-(ButtonX + 24, ButtonY + 10), Box(20000)
LINE (ButtonX, ButtonY)-(ButtonX + 24, ButtonY + 10), 8, B
ShowMOUSE
Interval .1
HideMOUSE
PUT (ButtonX, ButtonY), Box(20000), PSET
ShowMOUSE
Interval .01
Item = Item + 1
RETURN
END SUB
SUB TopMENU (InOUT)
STATIC MX1
IF InOUT = 0 THEN GOSUB DeLIGHT: EXIT SUB
SELECT CASE MouseX
CASE 20 TO 72
IF Item <> 1 THEN
GOSUB DeLIGHT
MX1 = 20: MX2 = 72
GOSUB HiLIGHT
Item = 1
END IF
CASE 594 TO 616
IF Item <> 2 THEN
GOSUB DeLIGHT
MX1 = 594: MX2 = 616
GOSUB HiLIGHT
Item = 2
END IF
CASE ELSE
GOSUB DeLIGHT
END SELECT
IF LB = -1 AND Item THEN
_SNDPLAYFILE "KONGtick.ogg", 1
SELECT CASE Item
CASE 1: GOSUB DeLIGHT: Instructions
CASE 2: GOSUB DeLIGHT: SYSTEM
END SELECT
END IF
EXIT SUB
HiLIGHT:
HideMOUSE
GET (MX1, 18)-(MX2, 27), Box(25000)
FOR x = MX1 TO MX2
FOR y = 18 TO 27
IF POINT(x, y) <> 1 AND POINT(x, y) <> 2 THEN
PSET (x, y), 13
END IF
NEXT y
NEXT x
ShowMOUSE
RETURN
DeLIGHT:
IF Item THEN
HideMOUSE
PUT (MX1, 18), Box(25000), PSET
ShowMOUSE
END IF
Item = 0
RETURN
END SUB
Required sound and graphics libraries. Incudes .bas file. Make your own folder like KONG2, unzip and compile the KONG2.bas with QB64.
![[Image: Screenshot-552.png]](https://i.ibb.co/zb79Zmw/Screenshot-552.png)
Linux is extremely fussy when it comes to filenames... lol... Finally got those sorted out... This is a very good version of the old gorillas game. Nicely done! A couple of audio files seem to be missing... "Explosion.ogg" and "Kong theme.ogg"
One thing I found annoying... My lack of skill... The computer seems to be quite accurate... I am not sure which is worse... The original gorilla waving arms or the new sinister 'laugh' when it wins... lol
Do you have any plans in recreating any more "old" games?
RE: A Growing Collection of Graphic Programs by TheBOB - johnno56 - 04-22-2022
[This comment was related to TheBOB's Monopoly Board.] - Pete
I call dibs on the Top Hat.... lol
RE: Discussion Board for the Collection of Graphic Programs by TheBOB. - mnrvovrfc - 08-03-2022
"CHOPPER" revisited:
Code: (Select All)
' °° '
' °° °°° '
' °°°°°° °°° °°° '
' °°°°°°° °°° °°° '
' °°° °° °°° °° °° °°° '
' °°° °° °° °° °° °°°° °°°° °°° °° °° °° '
' °°°° °° °°° °°°°°° °°°° °°°° °°°° °°°°°°° °° '
' °°°° °° °°°° °°° °°°°°°°°° °°°°°° °° °° °°°°°° °° '
' ²²² ²²²²²²² ²² ²² ²²²²²²²²²²²²²² ²²²²² ²²²² ²² '
' ²² ²²² ²²² ²²² ²²² ²² ²² ²²² ²² ²²²²²²²² ²²²²²² ²² '
' ²² ²²² ²²² ²² ²²² ²² ²²² ²² ²²² ²² ²²² ²² ²²²² ²²² '
' ²²²²²² ²² ²² ²²²²² ²²²²² ²²²²² ²²²²²² ²² ²²²² '
' ²² ²²²² ²²²² ²² '
' ²² ²² '
' ²²² ²²² '
' ²² ²² '
' '
' CHOPPER.BAS - Copyright (C) 2005 by Bob Seguin (Freeware) '
' '
'***************************************************************************'
DEFINT A-Z
'----------------------------------------------------------------------------
'$DYNAMIC
DIM SHARED Box(26000)
DIM SHARED MenuBOX(500)
DIM SHARED MenuBOX2(500)
DIM SHARED MenuBOX3(4000)
DIM SHARED CustomCOLORS(9, 20)
DIM SHARED FChar(1 TO 124)
DIM SHARED LB, RB, MouseX, MouseY
DIM SHARED TopMENU, Phase, Item, BarBOX, PaintITEM
DIM SHARED BikeCOLOR, FlameSTYLE, MenuITEM
CONST Degree! = 3.14159 / 180
i& = _LOADIMAGE("chopper.ico", 32)
IF i& < -1 THEN
_ICON i&
_FREEIMAGE i& ' release image handle after setting icon
END IF
_TITLE "Chopper by Bob Seguin"
DEF SEG = VARSEG(CustomCOLORS(0, 0))
BLOAD CheckFile$("CHColors.BSV"), VARPTR(CustomCOLORS(0, 0))
DEF SEG
SCREEN 12
BikeCOLOR = 3
FlameSTYLE = 1
SetPALETTE
ChopperIDE
DO
MouseSTATUS LB, RB, MouseX, MouseY
SELECT CASE MenuITEM
CASE 1: ProjectMENU
CASE 2: HelpMENU
END SELECT
SELECT CASE MouseY
CASE 32 TO 46: MenuBAR 1
CASE 294 TO 479
SELECT CASE Phase
CASE IS < 8: Assembly1
CASE 8 TO 20: Assembly2
CASE 21: HandleBARS 1
CASE 22 TO 24: Assembly3
CASE 25: PaintSHOP 1
END SELECT
CASE ELSE
IF TopMENU THEN MenuBAR 0
IF Item THEN DeLIGHT
IF BarBOX THEN HandleBARS 0
IF PaintITEM THEN PaintSHOP 0
END SELECT
IF Splash = 0 AND MouseY < 60 THEN
LINE (146, 154)-(493, 356), 0, BF
LINE (146, 288)-(493, 293), 1, BF
LINE (146, 288)-(493, 288), 2, BF
LINE (146, 293)-(493, 293), 5, BF
LINE (146, 252)-(493, 280), 2, BF
SetPALETTE
Splash = 1
END IF
ClearMOUSE
LoadPHASE
LOOP
END '************************** PALETTE DATA ********************************
PaletteDATA:
DATA 4,2,12,6,4,14,12,12,20
DATA 31,31,38,46,46,50,0,0,0
CustomCOLORS:
DATA 6,7,8,10,12,13,14
FlameCOLOR:
DATA 63,63,63,63,32,12,63,52,0
SilverCOLOR:
DATA 63,63,63,38,38,35,53,53,48
GoldCOLOR:
DATA 63,63,42,63,42,21,63,52,32
WhiteCOLOR:
DATA 63,63,63,48,48,53,53,53,58
REM $STATIC
SUB Assembly1
SHARED ItemX, ItemY, Frame, Extension, FrameCOLOR
SHARED ForkX, ForkY, WheelFX, WheelFY, WheelRX, WheelRY, BarX, BarY
SHARED OuterRADIUS, InnerRADIUS, FrontINDEX, RearINDEX, FrameX, FrameY
SELECT CASE Phase
CASE 1
SELECT CASE MouseX
CASE 116 TO 310
IF Item <> 1 THEN
DeLIGHT
ItemX = 156: ItemY = 452
HiLIGHT
Item = 1
END IF
CASE 330 TO 523
IF Item <> 2 THEN
DeLIGHT
ItemX = 390: ItemY = 452
HiLIGHT
Item = 2
END IF
CASE ELSE
DeLIGHT
END SELECT
CASE 2
SELECT CASE MouseX
CASE 20 TO 234
IF Item <> 3 THEN
DeLIGHT
ItemX = 90: ItemY = 430
HiLIGHT
Item = 3
END IF
CASE 255 TO 384
IF Item <> 4 THEN
DeLIGHT
ItemX = 271: ItemY = 430
HiLIGHT
Item = 4
END IF
CASE 405 TO 560
IF Item <> 5 THEN
DeLIGHT
ItemX = 431: ItemY = 430
HiLIGHT
Item = 5
END IF
CASE ELSE
DeLIGHT
END SELECT
CASE 3
SELECT CASE MouseX
CASE 110 TO 240
IF Item <> 6 THEN
DeLIGHT
ItemX = 112: ItemY = 440
HiLIGHT
Item = 6
END IF
CASE 260 TO 390
IF Item <> 7 THEN
DeLIGHT
ItemX = 270: ItemY = 440
HiLIGHT
Item = 7
END IF
CASE 410 TO 540
IF Item <> 8 THEN
DeLIGHT
ItemX = 420: ItemY = 440
HiLIGHT
Item = 8
END IF
END SELECT
CASE 4
IF Extension = 1 OR Extension = 2 THEN
SELECT CASE MouseX
CASE 40 TO 150
IF Item <> 9 THEN
DeLIGHT
ItemX = 40: ItemY = 445
HiLIGHT
Item = 9
END IF
CASE 170 TO 280
IF Item <> 10 THEN
DeLIGHT
ItemX = 180: ItemY = 445
HiLIGHT
Item = 10
END IF
CASE 340 TO 450
IF Item <> 11 THEN
DeLIGHT
ItemX = 330: ItemY = 445
HiLIGHT
Item = 11
END IF
CASE 470 TO 600
IF Item <> 12 THEN
DeLIGHT
ItemX = 470: ItemY = 445
HiLIGHT
Item = 12
END IF
CASE ELSE
DeLIGHT
END SELECT
ELSE
SELECT CASE MouseX
CASE 20 TO 138
IF Item <> 13 THEN
DeLIGHT
ItemX = 12: ItemY = 445
HiLIGHT
Item = 13
END IF
CASE 139 TO 232
IF Item <> 14 THEN
DeLIGHT
ItemX = 140: ItemY = 445
HiLIGHT
Item = 14
END IF
CASE 264 TO 386
IF Item <> 15 THEN
DeLIGHT
ItemX = 250: ItemY = 445
HiLIGHT
Item = 15
END IF
CASE 387 TO 490
IF Item <> 16 THEN
DeLIGHT
ItemX = 372: ItemY = 445
HiLIGHT
Item = 16
END IF
CASE 491 TO 600
IF Item <> 17 THEN
DeLIGHT
ItemX = 490: ItemY = 445
HiLIGHT
Item = 17
END IF
CASE ELSE
DeLIGHT
END SELECT
END IF
CASE 5
SELECT CASE MouseX
CASE 80 TO 198
IF Item <> 18 THEN
DeLIGHT
ItemX = 70: ItemY = 440
HiLIGHT
Item = 18
END IF
CASE 199 TO 318
IF Item <> 19 THEN
DeLIGHT
ItemX = 190: ItemY = 440
HiLIGHT
Item = 19
END IF
CASE 319 TO 438
IF Item <> 20 THEN
DeLIGHT
ItemX = 320: ItemY = 440
HiLIGHT
Item = 20
END IF
CASE 439 TO 560
IF Item <> 21 THEN
DeLIGHT
ItemX = 440: ItemY = 440
HiLIGHT
Item = 21
END IF
CASE ELSE
DeLIGHT
END SELECT
CASE 6
SELECT CASE MouseX
CASE 80 TO 198
IF Item <> 22 THEN
DeLIGHT
ItemX = 70: ItemY = 440
HiLIGHT
Item = 22
END IF
CASE 199 TO 318
IF Item <> 23 THEN
DeLIGHT
ItemX = 190: ItemY = 440
HiLIGHT
Item = 23
END IF
CASE 319 TO 438
IF Item <> 24 THEN
DeLIGHT
ItemX = 320: ItemY = 440
HiLIGHT
Item = 24
END IF
CASE 439 TO 560
IF Item <> 25 THEN
DeLIGHT
ItemX = 440: ItemY = 440
HiLIGHT
Item = 25
END IF
CASE ELSE
DeLIGHT
END SELECT
CASE 7
SELECT CASE MouseX
CASE 70 TO 169
IF Item <> 26 THEN
DeLIGHT
ItemX = 50: ItemY = 442
HiLIGHT
Item = 26
END IF
CASE 170 TO 269
IF Item <> 27 THEN
DeLIGHT
ItemX = 150: ItemY = 442
HiLIGHT
Item = 27
END IF
CASE 270 TO 369
IF Item <> 28 THEN
DeLIGHT
ItemX = 250: ItemY = 442
HiLIGHT
Item = 28
END IF
CASE 370 TO 469
IF Item <> 29 THEN
DeLIGHT
ItemX = 350: ItemY = 442
HiLIGHT
Item = 29
END IF
CASE 470 TO 569
IF Item <> 30 THEN
DeLIGHT
ItemX = 450: ItemY = 442
HiLIGHT
Item = 30
END IF
CASE ELSE
DeLIGHT
END SELECT
END SELECT
IF LB = -1 AND Item <> 0 THEN
SELECT CASE Item
CASE 1, 2
Frame = Item
DeLIGHT
Phase = 2
CASE 3, 4, 5
FrameCOLOR = Item - 2
DeLIGHT
Phase = 3
CASE 6, 7, 8
Extension = Item - 5
DeLIGHT
GOSUB SetFRAME
DeLIGHT
CASE 9 TO 17
GOSUB SetFORK
CASE 18 TO 21
GOSUB SetTIREF
Phase = 6
CASE 22 TO 25
GOSUB SetTIRER
Phase = 7
CASE 26 TO 30
GOSUB SetWHEELS
Phase = 8
END SELECT
END IF
EXIT SUB
'************************* SUBROUTINE SECTION BEGINS ************************
SetFRAME:
SELECT CASE Frame
CASE 1
SELECT CASE Extension
CASE 1
IF FrameCOLOR = 1 THEN LoadIMAGE 255, 130, CheckFile$("CHFrmRP.BSV"): loadfile CheckFile$("CHNkRP.BSV")
IF FrameCOLOR = 2 THEN LoadIMAGE 255, 130, CheckFile$("CHFrmRB.BSV"): loadfile CheckFile$("CHNkRB.BSV")
IF FrameCOLOR = 3 THEN LoadIMAGE 255, 130, CheckFile$("CHFrmRC.BSV"): loadfile CheckFile$("CHNkRC.BSV")
FrameX = 245: FrameY = 115
PUT (247, 125), Box(), AND
PUT (247, 125), Box(150)
CIRCLE (270, 262), 6, 5, , , .3
PAINT STEP(0, 0), 5
DRAW "U nR40 D R40 D L40"
PSET (316, 258), 5: DRAW "R120 F L121"
PSET (316, 266), 5: DRAW "R126 F L127"
LINE (310, 258)-(318, 262), 5, BF
LINE (311, 263)-(319, 267), 5, BF
LINE (380, 258)-(388, 262), 5, BF
LINE (382, 263)-(390, 267), 5, BF
CASE 2
IF FrameCOLOR = 1 THEN LoadIMAGE 261, 130, CheckFile$("CHFrmRP.BSV"): loadfile CheckFile$("CHNkXP.BSV")
IF FrameCOLOR = 2 THEN LoadIMAGE 261, 130, CheckFile$("CHFrmRB.BSV"): loadfile CheckFile$("CHNkXB.BSV")
IF FrameCOLOR = 3 THEN LoadIMAGE 261, 130, CheckFile$("CHFrmRC.BSV"): loadfile CheckFile$("CHNkXC.BSV")
FrameX = 251: FrameY = 115
PUT (252, 124), Box(), AND
PUT (252, 124), Box(150)
CIRCLE (270, 262), 6, 5, , , .3
PAINT STEP(0, 0), 5
DRAW "U nR47 D R47 D L47"
PSET (324, 258), 5: DRAW "R120 F L121"
PSET (324, 266), 5: DRAW "R126 F L127"
LINE (316, 258)-(324, 262), 5, BF
LINE (318, 263)-(326, 267), 5, BF
LINE (386, 258)-(394, 262), 5, BF
LINE (389, 263)-(396, 267), 5, BF
CASE 3
IF FrameCOLOR = 1 THEN LoadIMAGE 275, 130, CheckFile$("CHFrmRP.BSV"): loadfile CheckFile$("CHNkXXP.BSV")
IF FrameCOLOR = 2 THEN LoadIMAGE 275, 130, CheckFile$("CHFrmRB.BSV"): loadfile CheckFile$("CHNkXXB.BSV")
IF FrameCOLOR = 3 THEN LoadIMAGE 275, 130, CheckFile$("CHFrmRC.BSV"): loadfile CheckFile$("CHNkXXC.BSV")
FrameX = 265: FrameY = 115
PUT (267, 125), Box(), AND
PUT (267, 125), Box(150)
CIRCLE (270, 262), 6, 5, , , .3
PAINT STEP(0, 0), 5
DRAW "U nR65 D R65 D L65"
PSET (339, 258), 5: DRAW "R120 F L121"
PSET (339, 266), 5: DRAW "R126 F L127"
LINE (331, 258)-(339, 262), 5, BF
LINE (333, 263)-(341, 267), 5, BF
LINE (401, 258)-(409, 262), 5, BF
LINE (404, 263)-(411, 267), 5, BF
END SELECT
CASE 2
SELECT CASE Extension
CASE 1
IF FrameCOLOR = 1 THEN LoadIMAGE 250, 126, CheckFile$("CHFrmXP.BSV"): loadfile CheckFile$("CHNkRP.BSV")
IF FrameCOLOR = 2 THEN LoadIMAGE 250, 126, CheckFile$("CHFrmXB.BSV"): loadfile CheckFile$("CHNkRB.BSV")
IF FrameCOLOR = 3 THEN LoadIMAGE 250, 126, CheckFile$("CHFrmXC.BSV"): loadfile CheckFile$("CHNkRC.BSV")
FrameX = 250: FrameY = 126: DropSHADOW = 0
PUT (245, 124), Box(), AND
PUT (245, 124), Box(150)
CIRCLE (270, 262), 6, 5, , , .3
PAINT STEP(0, 0), 5
DRAW "U nR50 D R50 D L50"
PSET (324, 258), 5: DRAW "R130 F L131"
PSET (324, 266), 5: DRAW "R136 F L137"
LINE (316, 258)-(324, 262), 5, BF
LINE (317, 263)-(325, 267), 5, BF
LINE (360, 258)-(396, 262), 5, BF
LINE (362, 263)-(398, 267), 5, BF
CASE 2
IF FrameCOLOR = 1 THEN LoadIMAGE 256, 126, CheckFile$("CHFrmXP.BSV"): loadfile CheckFile$("CHNkXP.BSV")
IF FrameCOLOR = 2 THEN LoadIMAGE 256, 126, CheckFile$("CHFrmXB.BSV"): loadfile CheckFile$("CHNkXB.BSV")
IF FrameCOLOR = 3 THEN LoadIMAGE 256, 126, CheckFile$("CHFrmXC.BSV"): loadfile CheckFile$("CHNkXC.BSV")
FrameX = 256: FrameY = 126: DropSHADOW = 0
PUT (251, 124), Box(), AND
PUT (251, 124), Box(150)
CIRCLE (276, 262), 6, 5, , , .3
PAINT STEP(0, 0), 5
DRAW "U nR50 D R50 D L50"
PSET (328, 258), 5: DRAW "R130 F L131"
PSET (328, 266), 5: DRAW "R136 F L137"
LINE (324, 258)-(332, 262), 5, BF
LINE (325, 263)-(333, 267), 5, BF
LINE (368, 258)-(404, 262), 5, BF
LINE (370, 263)-(406, 267), 5, BF
CASE 3
IF FrameCOLOR = 1 THEN LoadIMAGE 270, 126, CheckFile$("CHFrmXP.BSV"): loadfile CheckFile$("CHNkXXP.BSV")
IF FrameCOLOR = 2 THEN LoadIMAGE 270, 126, CheckFile$("CHFrmXB.BSV"): loadfile CheckFile$("CHNkXXB.BSV")
IF FrameCOLOR = 3 THEN LoadIMAGE 270, 126, CheckFile$("CHFrmXC.BSV"): loadfile CheckFile$("CHNkXXC.BSV")
FrameX = 270: FrameY = 126: DropSHADOW = 0
PUT (265, 126), Box(), AND
PUT (265, 126), Box(150)
CIRCLE (278, 262), 6, 5, , , .3
PAINT STEP(0, 0), 5
DRAW "U nR58 D R58 D L58"
PSET (338, 258), 5: DRAW "R130 F L131"
PSET (338, 266), 5: DRAW "R138 F L139"
LINE (333, 258)-(341, 262), 5, BF
LINE (335, 263)-(343, 267), 5, BF
LINE (380, 258)-(416, 262), 5, BF
LINE (383, 263)-(419, 267), 5, BF
END SELECT
END SELECT
Phase = 4
RETURN
SetFORK:
IF Frame = 1 THEN
SELECT CASE Extension
CASE 1
SELECT CASE Item
CASE 9: loadfile CheckFile$("CHSprRP.BSI"): ForkX = 194: ForkY = 108
CASE 10: loadfile CheckFile$("CHSprRC.BSI"): ForkX = 194: ForkY = 108
CASE 11: loadfile CheckFile$("CHFrkGRP.BSI"): ForkX = 203: ForkY = 114
CASE 12: loadfile CheckFile$("CHFrkGRC.BSI"): ForkX = 203: ForkY = 114
END SELECT
CASE 2
SELECT CASE Item
CASE 9: loadfile CheckFile$("CHSprXP.BSI"): ForkX = 184: ForkY = 108
CASE 10: loadfile CheckFile$("CHSprXC.BSI"): ForkX = 184: ForkY = 108
CASE 11: loadfile CheckFile$("CHFrkGXP.BSI"): ForkX = 193: ForkY = 113
CASE 12: loadfile CheckFile$("CHFrkGXC.BSI"): ForkX = 193: ForkY = 113
END SELECT
CASE 3
SELECT CASE Item
CASE 13: loadfile CheckFile$("CHSprXXP.BSI"): ForkX = 176: ForkY = 113
CASE 14: loadfile CheckFile$("CHSprXXC.BSI"): ForkX = 176: ForkY = 113
CASE 15: loadfile CheckFile$("CHFrkXXP.BSI"): ForkX = 183: ForkY = 116
CASE 16: loadfile CheckFile$("CHFrkXXM.BSI"): ForkX = 183: ForkY = 116
CASE 17: loadfile CheckFile$("CHFrkXXC.BSI"): ForkX = 183: ForkY = 116
END SELECT
END SELECT
ELSE
SELECT CASE Extension
CASE 1
SELECT CASE Item
CASE 9: loadfile CheckFile$("CHSprRP.BSI"): ForkX = 192: ForkY = 108
CASE 10: loadfile CheckFile$("CHSprRC.BSI"): ForkX = 192: ForkY = 108
CASE 11: loadfile CheckFile$("CHFrkGRP.BSI"): ForkX = 203: ForkY = 114
CASE 12: loadfile CheckFile$("CHFrkGRC.BSI"): ForkX = 203: ForkY = 114
END SELECT
CASE 2
SELECT CASE Item
CASE 9: loadfile CheckFile$("CHSprXP.BSI"): ForkX = 182: ForkY = 108
CASE 10: loadfile CheckFile$("CHSprXC.BSI"): ForkX = 182: ForkY = 108
CASE 11: loadfile CheckFile$("CHFrkGXP.BSI"): ForkX = 190: ForkY = 113
CASE 12: loadfile CheckFile$("CHFrkGXC.BSI"): ForkX = 190: ForkY = 113
END SELECT
CASE 3
SELECT CASE Item
CASE 13: loadfile CheckFile$("CHSprXXP.BSI"): ForkX = 175: ForkY = 113
CASE 14: loadfile CheckFile$("CHSprXXC.BSI"): ForkX = 175: ForkY = 113
CASE 15: loadfile CheckFile$("CHFrkXXP.BSI"): ForkX = 181: ForkY = 116
CASE 16: loadfile CheckFile$("CHFrkXXM.BSI"): ForkX = 181: ForkY = 116
CASE 17: loadfile CheckFile$("CHFrkXXC.BSI"): ForkX = 181: ForkY = 116
END SELECT
END SELECT
END IF
PUT (ForkX + Box(0), ForkY + Box(1)), Box(3), AND
PUT (ForkX, ForkY), Box(Box(2))
PSET (ForkX + 12, 258), 5
SELECT CASE Extension
CASE 1
DRAW "R78 d9 L84 E R82 u7 L76 R64"
LINE STEP(-10, 0)-STEP(24, 7), 5, BF
CASE 2
DRAW "R88 d9 L94 E R92 u7 L86 R74"
LINE STEP(-10, 0)-STEP(24, 7), 5, BF
CASE 3
DRAW "R98 d9 L104 E R102 u7 L96 R84"
LINE STEP(-10, 0)-STEP(24, 7), 5, BF
END SELECT
DeLIGHT
Phase = 5
FOR x = 254 TO 300
FOR y = 110 TO 130
IF POINT(x, y) = 11 THEN
BarX = x: BarY = y
RETURN
END IF
NEXT y
NEXT x
RETURN
SetTIREF:
SELECT CASE ForkX
CASE 176: WheelFX = 179: WheelFY = 217
CASE 183: WheelFX = 188: WheelFY = 217
CASE 184: WheelFX = 188: WheelFY = 217
CASE 175: WheelFX = 178: WheelFY = 217 '
CASE 181: WheelFX = 186: WheelFY = 217 '
CASE 182: WheelFX = 186: WheelFY = 217 '
CASE 193: WheelFX = 199: WheelFY = 217
CASE 194: WheelFX = 197: WheelFY = 217
CASE 190: WheelFX = 196: WheelFY = 217 '
CASE 192: WheelFX = 195: WheelFY = 217 '
CASE 203: WheelFX = 208: WheelFY = 217
CASE 203: WheelFX = 208: WheelFY = 217 '
END SELECT
SELECT CASE Item
CASE 18: InnerRADIUS = 38: FrontINDEX = 0
CASE 19: InnerRADIUS = 35: FrontINDEX = 1800
CASE 20: InnerRADIUS = 33: FrontINDEX = 3600
CASE 21: InnerRADIUS = 30: FrontINDEX = 5400
END SELECT
Tire WheelFX - 100, WheelFY - 100, 48, InnerRADIUS
DeLIGHT
RETURN
SetTIRER:
IF Frame = 1 THEN
SELECT CASE Extension
CASE 1: WheelRX = 435: WheelRY = 217
CASE 2: WheelRX = 441: WheelRY = 217
CASE 3: WheelRX = 455: WheelRY = 217
END SELECT
OuterRADIUS = 48
SELECT CASE Item
CASE 22: InnerRADIUS = 33: RearINDEX = 3600
CASE 23: InnerRADIUS = 30: RearINDEX = 5400
CASE 24: InnerRADIUS = 27: RearINDEX = 7200
CASE 25: InnerRADIUS = 24: RearINDEX = 9000
END SELECT
ELSE
SELECT CASE Extension
CASE 1: WheelRX = 440: WheelRY = 223
CASE 2: WheelRX = 446: WheelRY = 223
CASE 3: WheelRX = 460: WheelRY = 223
END SELECT
OuterRADIUS = 42
SELECT CASE Item
CASE 22: InnerRADIUS = 27: RearINDEX = 10800
CASE 23: InnerRADIUS = 25: RearINDEX = 12600
CASE 24: InnerRADIUS = 23: RearINDEX = 14400
CASE 25: InnerRADIUS = 21: RearINDEX = 16200
END SELECT
END IF
Tire WheelRX + 100, WheelRY - 100, OuterRADIUS, InnerRADIUS
DeLIGHT
RETURN
SetWHEELS:
SELECT CASE Item
CASE 26: File$ = "CHSpokes.BSV"
CASE 27: File$ = "CHMag1.BSV"
CASE 28: File$ = "CHMag2.BSV"
CASE 29: File$ = "CHMag3.BSV"
CASE 30: File$ = "CHMag4.BSV"
END SELECT
LoadFILE CheckFile$(File$)
PUT (WheelFX - 140, WheelFY - 140), Box(FrontINDEX), PSET
PUT (WheelRX + 60, WheelRY - 140), Box(RearINDEX), PSET
DeLIGHT
RETURN
END SUB
SUB Assembly2
SHARED ItemX, ItemY, Frame, Extension, FrameCOLOR, Cover, Tank
SHARED ForkX, ForkY, WheelFX, WheelFY, WheelRX, WheelRY, BarX, BarY
SHARED OuterRADIUS, InnerRADIUS, FrontINDEX, RearINDEX, FrameX, FrameY
SHARED MotorSTYLE, HighMEG, HighPIPE, OT, LightX, LightY, FenderSTYLE
SHARED FFLX, FFRX, FFTY, FFBY, RFLX, RFRX, RFTY, RFBY, GPaint, TX, TY, TTY
SELECT CASE Phase
CASE 8
SELECT CASE MouseX
CASE 95 TO 225
IF Item <> 31 THEN
DeLIGHT
ItemX = 95: ItemY = 445
HiLIGHT
Item = 31
END IF
CASE 255 TO 385
IF Item <> 32 THEN
DeLIGHT
ItemX = 255: ItemY = 445
HiLIGHT
Item = 32
END IF
CASE 415 TO 545
IF Item <> 33 THEN
DeLIGHT
ItemX = 415: ItemY = 445
HiLIGHT
Item = 33
END IF
CASE ELSE
DeLIGHT
END SELECT
CASE 9
SELECT CASE MouseX
CASE 135 TO 235
IF Item <> 34 THEN
DeLIGHT
ItemX = 110: ItemY = 420
HiLIGHT
Item = 34
END IF
CASE 268 TO 368
IF Item <> 35 THEN
DeLIGHT
ItemX = 246: ItemY = 420
HiLIGHT
Item = 35
END IF
CASE 400 TO 500
IF Item <> 36 THEN
DeLIGHT
ItemX = 382: ItemY = 420
HiLIGHT
Item = 36
END IF
CASE ELSE
DeLIGHT
END SELECT
CASE 10
SELECT CASE MouseX
CASE 124 TO 234
IF Item <> 37 THEN
DeLIGHT
ItemX = 114: ItemY = 424
HiLIGHT
Item = 37
END IF
CASE 278 TO 358
IF Item <> 38 THEN
DeLIGHT
ItemX = 268: ItemY = 424
HiLIGHT
Item = 38
END IF
CASE 406 TO 516
IF Item <> 39 THEN
DeLIGHT
ItemX = 396: ItemY = 424
HiLIGHT
Item = 39
END IF
CASE ELSE
DeLIGHT
END SELECT
CASE 11
SELECT CASE MouseX
CASE 120 TO 219
IF Item <> 40 THEN
DeLIGHT
ItemX = 100: ItemY = 398
HiLIGHT
Item = 40
END IF
CASE 220 TO 319
IF Item <> 41 THEN
DeLIGHT
ItemX = 210: ItemY = 398
HiLIGHT
Item = 41
END IF
CASE 320 TO 419
IF Item <> 42 THEN
DeLIGHT
ItemX = 310: ItemY = 398
HiLIGHT
Item = 42
END IF
CASE 420 TO 519
IF Item <> 43 THEN
DeLIGHT
ItemX = 420: ItemY = 398
HiLIGHT
Item = 43
END IF
CASE ELSE
DeLIGHT
END SELECT
CASE 12
SELECT CASE MouseX
CASE 120 TO 219
IF Item <> 44 THEN
DeLIGHT
ItemX = 100: ItemY = 398
HiLIGHT
Item = 44
END IF
CASE 220 TO 319
IF Item <> 45 THEN
DeLIGHT
ItemX = 200: ItemY = 398
HiLIGHT
Item = 45
END IF
CASE 320 TO 419
IF Item <> 46 THEN
DeLIGHT
ItemX = 300: ItemY = 398
HiLIGHT
Item = 46
END IF
CASE 420 TO 519
IF Item <> 146 THEN
DeLIGHT
ItemX = 400: ItemY = 398
HiLIGHT
Item = 146
END IF
CASE ELSE
DeLIGHT
END SELECT
CASE 13
SELECT CASE MouseX
CASE 110 TO 219
IF Item <> 47 THEN
DeLIGHT
ItemX = 100: ItemY = 390
HiLIGHT
Item = 47
END IF
CASE 220 TO 329
IF Item <> 48 THEN
DeLIGHT
ItemX = 220: ItemY = 390
HiLIGHT
Item = 48
END IF
CASE 330 TO 439
IF Item <> 49 THEN
DeLIGHT
ItemX = 330: ItemY = 390
HiLIGHT
Item = 49
END IF
CASE 440 TO 549
IF Item <> 50 THEN
DeLIGHT
ItemX = 430: ItemY = 390
HiLIGHT
Item = 50
END IF
CASE ELSE
DeLIGHT
END SELECT
CASE 14
SELECT CASE MouseX
CASE 178 TO 308
IF Item <> 51 THEN
DeLIGHT
ItemX = 178: ItemY = 408
HiLIGHT
Item = 51
END IF
CASE 338 TO 468
IF Item <> 52 THEN
DeLIGHT
ItemX = 338: ItemY = 408
HiLIGHT
Item = 52
END IF
CASE ELSE
DeLIGHT
END SELECT
CASE 15
SELECT CASE MouseX
CASE 90 TO 220
IF Item <> 53 THEN
DeLIGHT
ItemX = 90: ItemY = 411
HiLIGHT
Item = 53
END IF
CASE 250 TO 380
IF Item <> 54 THEN
DeLIGHT
ItemX = 250: ItemY = 411
HiLIGHT
Item = 54
END IF
CASE 412 TO 542
IF Item <> 55 THEN
DeLIGHT
ItemX = 412: ItemY = 411
HiLIGHT
Item = 55
END IF
CASE ELSE
DeLIGHT
END SELECT
CASE 16
SELECT CASE MouseX
CASE 40 TO 223
IF Item <> 56 THEN
DeLIGHT
ItemX = 70: ItemY = 410
HiLIGHT
Item = 56
END IF
CASE 224 TO 409
IF Item <> 57 THEN
DeLIGHT
ItemX = 250: ItemY = 410
HiLIGHT
Item = 57
END IF
CASE 410 TO 600
IF Item <> 58 THEN
DeLIGHT
ItemX = 430: ItemY = 410
HiLIGHT
Item = 58
END IF
CASE ELSE
DeLIGHT
END SELECT
CASE 17
SELECT CASE MouseX
CASE 50 TO 200
IF Item <> 59 THEN
DeLIGHT
ItemX = 60: ItemY = 428
HiLIGHT
Item = 59
END IF
CASE 230 TO 380
IF Item <> 60 THEN
DeLIGHT
ItemX = 240: ItemY = 428
HiLIGHT
Item = 60
END IF
CASE 410 TO 560
IF Item <> 61 THEN
DeLIGHT
ItemX = 420: ItemY = 428
HiLIGHT
Item = 61
END IF
CASE ELSE
DeLIGHT
END SELECT
CASE 18
SELECT CASE MouseX
CASE 65 TO 164
IF Item <> 62 THEN
DeLIGHT
ItemX = 50: ItemY = 412
HiLIGHT
Item = 62
END IF
CASE 165 TO 264
IF Item <> 63 THEN
DeLIGHT
ItemX = 150: ItemY = 412
HiLIGHT
Item = 63
END IF
CASE 265 TO 364
IF Item <> 64 THEN
DeLIGHT
ItemX = 250: ItemY = 412
HiLIGHT
Item = 64
END IF
CASE 365 TO 464
IF Item <> 65 THEN
DeLIGHT
ItemX = 350: ItemY = 412
HiLIGHT
Item = 65
END IF
CASE 465 TO 564
IF Item <> 66 THEN
DeLIGHT
ItemX = 450: ItemY = 412
HiLIGHT
Item = 66
END IF
CASE ELSE
DeLIGHT
END SELECT
CASE 19
SELECT CASE MouseX
CASE 60 TO 139
IF Item <> 67 THEN
DeLIGHT
ItemX = 20: ItemY = 396
HiLIGHT
Item = 67
END IF
CASE 140 TO 219
IF Item <> 68 THEN
DeLIGHT
ItemX = 125: ItemY = 396
HiLIGHT
Item = 68
END IF
CASE 240 TO 319
IF Item <> 69 THEN
DeLIGHT
ItemX = 202: ItemY = 396
HiLIGHT
Item = 69
END IF
CASE 320 TO 399
IF Item <> 70 THEN
DeLIGHT
ItemX = 304: ItemY = 396
HiLIGHT
Item = 70
END IF
CASE 420 TO 499
IF Item <> 71 THEN
DeLIGHT
ItemX = 384: ItemY = 396
HiLIGHT
Item = 71
END IF
CASE 500 TO 579
IF Item <> 72 THEN
DeLIGHT
ItemX = 490: ItemY = 396
HiLIGHT
Item = 72
END IF
CASE ELSE
DeLIGHT
END SELECT
CASE 20
SELECT CASE MouseX
CASE 140 TO 219
IF Item <> 67 THEN
DeLIGHT
ItemX = 100: ItemY = 396
HiLIGHT
Item = 67
END IF
CASE 220 TO 299
IF Item <> 68 THEN
DeLIGHT
ItemX = 210: ItemY = 396
HiLIGHT
Item = 68
END IF
CASE 340 TO 419
IF Item <> 69 THEN
DeLIGHT
ItemX = 290: ItemY = 396
HiLIGHT
Item = 69
END IF
CASE 420 TO 499
IF Item <> 70 THEN
DeLIGHT
ItemX = 420: ItemY = 396
HiLIGHT
Item = 70
END IF
CASE ELSE
DeLIGHT
END SELECT
END SELECT
IF LB = -1 AND Item <> 0 THEN
SELECT CASE Item
CASE 31
loadfile CheckFile$("CHFndrFS.BSV"): GOSUB FrontWHEEL
loadfile CheckFile$("CHFndrRS.BSV"): GOSUB RearWHEEL
FenderSTYLE = 1
GOSUB Transfer
CASE 32
loadfile CheckFile$("CHFndrFC.BSV"): GOSUB FrontWHEEL
loadfile CheckFile$("CHFndrRC.BSV"): GOSUB RearWHEEL
FenderSTYLE = 2
GOSUB Transfer
CASE 33
loadfile CheckFile$("CHFndrFF.BSV"): GOSUB FrontWHEEL
loadfile CheckFile$("CHFndrRF.BSV"): GOSUB RearWHEEL
FenderSTYLE = 3
GOSUB Transfer
CASE 34
IF Frame = 2 THEN
GET (FrameX + 100, FrameY + 40)-STEP(20, 30), Box()
PUT (FrameX + 70, FrameY + 25), Box(), PSET
LINE (FrameX + 90, FrameY + 110)-STEP(40, 2), 0, BF
CIRCLE (FrameX + 53, FrameY + 108), 3, 2
PAINT STEP(0, 0), 4, 2
CIRCLE (FrameX + 53, FrameY + 108), 2, 15, 0, 3
LINE (FrameX + 50, FrameY + 101)-STEP(1, 1), 4, B
CIRCLE (FrameX + 53, FrameY + 108), 3, 5, 3, 0
LINE STEP(-2, 0)-STEP(4, 0), 3
END IF
loadfile CheckFile$("CHMtr750.BSI")
MotorSTYLE = 1
GOSUB InstallMOTOR
DeLIGHT
Phase = 15
CASE 35
DeLIGHT
MotorSTYLE = 2
Phase = 10
CASE 36
DeLIGHT
MotorSTYLE = 3
Phase = 10
CASE 37
IF MotorSTYLE = 2 THEN
loadfile CheckFile$("CHMtrVKP.BSI")
ELSE
loadfile CheckFile$("CHMtrVBP.BSI")
END IF
GOSUB InstallMOTOR
CASE 38
IF MotorSTYLE = 2 THEN
loadfile CheckFile$("CHMtrVKB.BSI")
ELSE
loadfile CheckFile$("CHMtrVBB.BSI")
END IF
GOSUB InstallMOTOR
CASE 39
IF MotorSTYLE = 2 THEN
loadfile CheckFile$("CHMtrVKC.BSI")
ELSE
loadfile CheckFile$("CHMtrVBC.BSI")
END IF
GOSUB InstallMOTOR
CASE 40
LoadBSI FrameX, FrameY, CheckFile$("CHDrvCH.BSI")
loadfile CheckFile$("CHShdowD.BSI")
PUT (FrameX + Box(0), 268), Box(3), AND
PUT (FrameX + Box(0), 268), Box(Box(2))
DeLIGHT
Phase = 13
CASE 41 TO 43
IF Item = 41 THEN LoadBSI FrameX, FrameY, CheckFile$("CHDrvBP.BSI")
IF Item = 42 THEN LoadBSI FrameX, FrameY, CheckFile$("CHDrvBB.BSI")
IF Item = 43 THEN LoadBSI FrameX, FrameY, CheckFile$("CHDrvBC.BSI")
loadfile CheckFile$("CHShdowD.BSI")
PUT (FrameX + Box(0), 268), Box(3), AND
PUT (FrameX + Box(0), 268), Box(Box(2))
DeLIGHT
Phase = 12
CASE 44, 45, 46, 146
IF Item = 44 THEN LoadBSI FrameX, FrameY, CheckFile$("CHDrvCP.BSI"): Cover = 1
IF Item = 45 THEN LoadBSI FrameX, FrameY, CheckFile$("CHDrvCB.BSI")
IF Item = 46 THEN LoadBSI FrameX, FrameY, CheckFile$("CHDrvCC.BSI")
DeLIGHT
Phase = 13
CASE 47 TO 50
IF Item = 47 THEN LoadBSI FrameX, FrameY, CheckFile$("CHBrthr3.BSI")
IF Item = 48 THEN LoadBSI FrameX, FrameY, CheckFile$("CHBrthr4.BSI")
IF Item = 49 THEN LoadBSI FrameX, FrameY, CheckFile$("CHBrthr1.BSI")
IF Item = 50 THEN LoadBSI FrameX, FrameY, CheckFile$("CHBrthr2.BSI")
DeLIGHT
Phase = 14
CASE 51, 52
IF Frame = 1 THEN
IF Item = 51 THEN FileNAME$ = "CHRDrRVC.BSI"
IF Item = 52 THEN FileNAME$ = "CHRDrRVB.BSI"
ELSE
IF Item = 51 THEN FileNAME$ = "CHRDrXVC.BSI"
IF Item = 52 THEN FileNAME$ = "CHRDrXVB.BSI"
END IF
LoadBSI FrameX, FrameY, CheckFile$(FileNAME$)
DeLIGHT
Phase = 17
CASE 53 TO 55
IF Frame = 1 THEN
IF Item = 53 THEN FileNAME$ = "CHRDrR7O.BSI"
IF Item = 54 THEN FileNAME$ = "CHRDrR7P.BSI": GPaint = 1
IF Item = 55 THEN FileNAME$ = "CHRDrR7C.BSI"
ELSE
IF Item = 53 THEN FileNAME$ = "CHRDrX7O.BSI"
IF Item = 54 THEN FileNAME$ = "CHRDrX7P.BSI": GPaint = 1
IF Item = 55 THEN FileNAME$ = "CHRDrX7C.BSI"
END IF
LoadBSI FrameX, FrameY, CheckFile$(FileNAME$)
DeLIGHT
Phase = 16
CASE 56 TO 58
IF Item = 56 THEN LoadBSI FrameX, FrameY, CheckFile$("CHExBLST.BSI")
IF Item = 57 THEN LoadBSI FrameX, FrameY, CheckFile$("CHExBHMG.BSI"): HighMEG = 1
IF Item = 58 THEN LoadBSI FrameX, FrameY, CheckFile$("CHExBLMG.BSI")
IF Frame = 1 THEN ShadowDROP = 11 ELSE ShadowDROP = 0
LoadBSI FrameX, FrameY + ShadowDROP, CheckFile$("CHShdo7X.BSI")
DeLIGHT
Phase = 18
CASE 59 TO 61
IF Item = 59 THEN LoadBSI FrameX, FrameY, CheckFile$("CHExVLMG.BSI"): Extend = 0
IF Item = 60 THEN LoadBSI FrameX, FrameY, CheckFile$("CHExVLSH.BSI"): Extend = -20
IF Item = 61 THEN LoadBSI FrameX, FrameY, CheckFile$("CHExVHOS.BSI"): Extend = 60: HighPIPE = 1
IF Frame = 1 THEN ShadowDROP = 11 ELSE ShadowDROP = 0
LoadBSI FrameX + 12, FrameY + 44 + ShadowDROP, CheckFile$("CHShdoVX.BSI")
LINE (FrameX + 120, FrameY + 143 + ShadowDROP)-(FrameX + 200 + Extend, FrameY + 147 + ShadowDROP), 5, BF
DRAW "R5 H5 D5 R bU p5,5"
DeLIGHT
Phase = 18
CASE 62 TO 66
IF Frame = 1 THEN TankY = 5 ELSE TankY = 0
IF Item = 62 THEN
LoadBSI FrameX, FrameY + TankY, CheckFile$("CHFTnkTD.BSI")
Tank = 1: TX = 2: TY = 2 + TankY
IF Frame = 1 THEN TTY = 5 ELSE TTY = 0
END IF
IF Item = 63 THEN
LoadBSI FrameX, FrameY, CheckFile$("CHFTnkSC.BSI")
TX = 4: Tank = 2: TY = 6 + TankY
TTY = 0
END IF
IF Item = 64 THEN
LoadBSI FrameX, FrameY + TankY, CheckFile$("CHFTnkOS.BSI")
Tank = 3: TX = 0: TY = TankY
IF Frame = 1 THEN TTY = 4 ELSE TTY = 0
END IF
IF Item = 65 THEN
LoadBSI FrameX, FrameY + TankY, CheckFile$("CHFTnkCB.BSI")
Tank = 4: TX = 10: TY = 3 + TankY
IF Frame = 1 THEN TTY = 4 ELSE TTY = 0
END IF
IF Item = 66 THEN
LoadBSI FrameX, FrameY + TankY, CheckFile$("CHFTnkBR.BSI")
Tank = 5
TX = 2
TTY = 4
IF Frame = 1 THEN TY = 12 ELSE TY = 7
IF Frame = 1 THEN TTY = 4 ELSE TTY = 0
END IF
DeLIGHT
ClearBOX
IF MotorSTYLE = 1 AND Frame = 1 THEN
Phase = 19
ELSE
Phase = 20
END IF
CASE 67 TO 72
IF Item = 67 THEN LoadBSI FrameX, FrameY, CheckFile$("CHOTnkHP.BSI"): OT = 1
IF Item = 68 THEN LoadBSI FrameX, FrameY, CheckFile$("CHOTnkHC.BSI"): OT = 2
IF Item = 69 THEN LoadBSI FrameX, FrameY, CheckFile$("CHOTnkCP.BSI"): OT = 3
IF Item = 70 THEN LoadBSI FrameX, FrameY, CheckFile$("CHOTnkCC.BSI"): OT = 4
IF Item = 71 THEN LoadBSI FrameX, FrameY, CheckFile$("CHOTnkBP.BSI"): OT = 5
IF Item = 72 THEN LoadBSI FrameX, FrameY, CheckFile$("CHOTnkBC.BSI"): OT = 6
IF HighMEG = 1 THEN
LoadBSI FrameX, FrameY, CheckFile$("CHExBHMG.BSI")
HighMEG = 0
END IF
DeLIGHT
FOR x = BarX - 40 TO BarX - 10
FOR y = BarY + 10 TO BarY + 40
IF POINT(x, y) = 14 THEN
LightX = x
LightY = y
PSET (x, y), 15
GOTO Continue
END IF
NEXT y
NEXT x
Continue:
Phase = 21
END SELECT
END IF
EXIT SUB
'************************* SUBROUTINE SECTION BEGINS ************************
FrontWHEEL:
PUT (WheelFX - 153, WheelFY - 157), Box(3200), AND
PUT (WheelFX - 153, WheelFY - 157), Box()
RETURN
RearWHEEL:
PUT (WheelRX + 45, WheelRY - 155), Box(3200), AND
PUT (WheelRX + 45, WheelRY - 155), Box()
DeLIGHT
RETURN
Transfer:
LoadIMAGE 170, 80, CheckFile$("CHPrepAR.BSV")
LoadIMAGE 170, 80, CheckFile$("CHInstW.BSV")
FFLX = Seeker(WheelFX - 153, WheelFY - 157, 0)
FFRX = Seeker(WheelFX - 153, WheelFY - 157, 1)
FFTY = Seeker(WheelFX - 153, WheelFY - 157, 2)
FFBY = Seeker(WheelFX - 153, WheelFY - 157, 3)
OPEN "FF.DAT" FOR OUTPUT AS #1
WRITE #1, FFLX + 100, FFRX - FFLX, FFTY + 100, FFBY - FFTY
FOR x = FFLX TO FFRX
FOR y = FFTY TO FFBY
IF POINT(x + 100, y + 100) = 0 THEN WRITE #1, 1 ELSE WRITE #1, 0
NEXT y
NEXT x
CLOSE #1
PSET (WheelFX - 43, WheelFY + 48), 5
DRAW "R91 M+2,-5 L85 M-8,+5 R10 BU2 P5,5"
FOR x = WheelFX - 153 TO WheelFX - 43
FOR y = WheelFY - 157 TO WheelFY - 47
IF POINT(x, y) <> 0 THEN
IF y < WheelFY - 72 THEN
IF POINT(x + 100, y + 100) = 0 THEN
PSET (x + 100, y + 100), POINT(x, y)
END IF
ELSE
PSET (x + 100, y + 100), POINT(x, y)
END IF
PSET (x, y), 0
END IF
NEXT y
NEXT x
RFLX = Seeker(WheelRX + 45, WheelRY - 157, 0)
RFRX = Seeker(WheelRX + 45, WheelRY - 157, 1)
RFTY = Seeker(WheelRX + 45, WheelRY - 157, 2)
RFBY = Seeker(WheelRX + 45, WheelRY - 157, 3)
OPEN "RF.DAT" FOR OUTPUT AS #1
WRITE #1, RFLX - 100, RFRX - RFLX, RFTY + 100, RFBY - RFTY
FOR x = RFLX TO RFRX
FOR y = RFTY TO RFBY
IF POINT(x - 100, y + 100) = 0 THEN WRITE #1, 1 ELSE WRITE #1, 0
NEXT y
NEXT x
CLOSE #1
IF Frame = 2 THEN
PSET (WheelRX - 43, WheelRY + 42), 5
ELSE
PSET (WheelRX - 43, WheelRY + 48), 5
END IF
DRAW "R91 M-8,-5 L88 F5 R20 BU3 P5,5"
FOR x = WheelRX + 45 TO WheelRX + 155
FOR y = WheelRY - 155 TO WheelRY - 45
IF POINT(x, y) <> 0 THEN
IF y < WheelRY - 72 THEN
IF POINT(x - 100, y + 100) = 0 THEN
PSET (x - 100, y + 100), POINT(x, y)
END IF
ELSE
PSET (x - 100, y + 100), POINT(x, y)
END IF
PSET (x, y), 0
END IF
NEXT y
NEXT x
LoadIMAGE 170, 80, CheckFile$("CHInstW.BSV")
Phase = 9
RETURN
InstallMOTOR:
PUT (FrameX + Box(0), FrameY + Box(1)), Box(3), AND
PUT (FrameX + Box(0), FrameY + Box(1)), Box(Box(2))
IF MotorSTYLE = 1 THEN
loadfile CheckFile$("CHShdow7.BSI")
PUT (FrameX + Box(0), 251), Box(3), AND
PUT (FrameX + Box(0), 251), Box(Box(2))
ELSE
IF Frame = 1 THEN
SELECT CASE FrameCOLOR
CASE 1: Colr1 = 6: Colr2 = 13
CASE 2: Colr1 = 5: Colr2 = 2
CASE 3: Colr1 = 4: Colr2 = 15
END SELECT
PSET (FrameX + Box(0) + 32, FrameY + Box(1)), Colr1
DRAW "U8 M+4,+2 D6 L4 BE2 P" + LTRIM$(STR$(Colr1)) + "," + LTRIM$(STR$(Colr1))
PSET (FrameX + Box(0) + 32, FrameY + Box(1)), Colr2
DRAW "U7"
END IF
LoadBSI FrameX, FrameY, CheckFile$("CHLnkage.BSI")
loadfile CheckFile$("CHShdowP.BSI")
PUT (FrameX + Box(0), 254), Box(3), AND
PUT (FrameX + Box(0), 254), Box(Box(2))
loadfile CheckFile$("CHShdowV.BSI")
PUT (FrameX + Box(0), 254), Box(3), AND
PUT (FrameX + Box(0), 254), Box(Box(2))
END IF
DeLIGHT
IF MotorSTYLE > 1 THEN
END IF
Phase = 11
RETURN
END SUB
SUB Assembly3
SHARED ItemX, ItemY, Frame, Extension, FrameCOLOR
SHARED ForkX, ForkY, WheelFX, WheelFY, WheelRX, WheelRY, BarX, BarY
SHARED OuterRADIUS, InnerRADIUS, FrontINDEX, RearINDEX, FrameX, FrameY
SHARED MotorSTYLE, HighMEG, HighPIPE, OT, LightX, LightY, FenderSTYLE
SHARED FFLX, FFRX, FFTY, FFBY, RFLX, RFRX, RFTY, RFBY
SELECT CASE Phase
CASE 22
SELECT CASE MouseX
CASE 15 TO 114
IF Item <> 73 THEN
DeLIGHT
ItemX = 12: ItemY = 406
HiLIGHT
Item = 73
END IF
CASE 115 TO 214
IF Item <> 74 THEN
DeLIGHT
ItemX = 98: ItemY = 406
HiLIGHT
Item = 74
END IF
CASE 215 TO 314
IF Item <> 75 THEN
DeLIGHT
ItemX = 200: ItemY = 406
HiLIGHT
Item = 75
END IF
CASE 315 TO 409
IF Item <> 76 THEN
DeLIGHT
ItemX = 300: ItemY = 406
HiLIGHT
Item = 76
END IF
CASE 410 TO 519
IF Item <> 77 THEN
DeLIGHT
ItemX = 400: ItemY = 406
HiLIGHT
Item = 77
END IF
CASE 520 TO 624
IF Item <> 78 THEN
DeLIGHT
ItemX = 497: ItemY = 406
HiLIGHT
Item = 78
END IF
CASE ELSE
DeLIGHT
END SELECT
CASE 23
SELECT CASE MouseX
CASE 60 TO 139
IF Item <> 79 THEN
DeLIGHT
ItemX = 20: ItemY = 394
HiLIGHT
Item = 79
END IF
CASE 140 TO 219
IF Item <> 80 THEN
DeLIGHT
ItemX = 126: ItemY = 394
HiLIGHT
Item = 80
END IF
CASE 240 TO 319
IF Item <> 81 THEN
DeLIGHT
ItemX = 204: ItemY = 394
HiLIGHT
Item = 81
END IF
CASE 320 TO 399
IF Item <> 82 THEN
DeLIGHT
ItemX = 306: ItemY = 394
HiLIGHT
Item = 82
END IF
CASE 420 TO 499
IF Item <> 83 THEN
DeLIGHT
ItemX = 386: ItemY = 394
HiLIGHT
Item = 83
END IF
CASE 500 TO 580
IF Item <> 84 THEN
DeLIGHT
ItemX = 486: ItemY = 394
HiLIGHT
Item = 84
END IF
CASE ELSE
DeLIGHT
END SELECT
CASE 24
SELECT CASE MouseX
CASE 125 TO 235
IF Item <> 85 THEN
DeLIGHT
ItemX = 115: ItemY = 420
HiLIGHT
Item = 85
END IF
CASE 265 TO 375
IF Item <> 86 THEN
DeLIGHT
ItemX = 255: ItemY = 420
HiLIGHT
Item = 86
END IF
CASE 405 TO 515
IF Item <> 87 THEN
DeLIGHT
ItemX = 395: ItemY = 420
HiLIGHT
Item = 87
END IF
CASE ELSE
DeLIGHT
END SELECT
END SELECT
IF LB = -1 AND Item <> 0 THEN
SELECT CASE Item
CASE 73 TO 78
IF Frame = 1 THEN SeatUP = -2 ELSE SeatUP = 0
IF Item = 73 THEN LoadBSI FrameX, FrameY + SeatUP, CheckFile$("CHStOSHP.BSI")
IF Item = 74 THEN LoadBSI FrameX, FrameY + SeatUP, CheckFile$("CHStOSHS.BSI")
IF Item = 75 THEN LoadBSI FrameX, FrameY + SeatUP, CheckFile$("CHStOSLP.BSI")
IF Item = 76 THEN LoadBSI FrameX, FrameY + SeatUP, CheckFile$("CHStOSLS.BSI")
IF Item = 77 THEN
IF Frame = 1 THEN
LoadBSI FrameX + 10, FrameY + 15, CheckFile$("CHStBNAR.BSI")
CIRCLE (FrameX + 156, FrameY + 64), 4, 15, 1, 3
PSET STEP(2, -4), 3
PSET STEP(-4, 0), 3
ELSE
SELECT CASE FrameCOLOR
CASE 1: LoadBSI FrameX + 4, FrameY + 2, CheckFile$("CHStBNAP.BSI")
CASE 2: LoadBSI FrameX + 4, FrameY + 2, CheckFile$("CHStBNAB.BSI")
CASE 3: LoadBSI FrameX + 4, FrameY + 2, CheckFile$("CHStBNAC.BSI")
END SELECT
END IF
END IF
IF Item = 78 THEN
IF Frame = 1 THEN
SELECT CASE FrameCOLOR
CASE 1: LoadBSI FrameX + 8, FrameY + 4, CheckFile$("CHStCHPP.BSI")
CASE 2: LoadBSI FrameX + 8, FrameY + 4, CheckFile$("CHStCHPB.BSI")
CASE 3: LoadBSI FrameX + 8, FrameY + 4, CheckFile$("CHStCHPC.BSI")
END SELECT
IF OT > 4 THEN
IF OT = 5 THEN LoadBSI FrameX, FrameY, CheckFile$("CHOTnkBP.BSI")
IF OT = 6 THEN LoadBSI FrameX, FrameY, CheckFile$("CHOTnkBC.BSI")
IF HighMEG THEN LoadBSI FrameX, FrameY, CheckFile$("CHExBHMG.BSI")
END IF
ELSE
LoadBSI FrameX + 8, FrameY + 4, CheckFile$("CHStCHPE.BSI")
END IF
END IF
DeLIGHT
Phase = 23
CASE 79 TO 84
IF Item = 79 THEN LoadBSI LightX, LightY, CheckFile$("CHHDLTLP.BSI")
IF Item = 80 THEN LoadBSI LightX, LightY, CheckFile$("CHHDLTLC.BSI")
IF Item = 81 THEN LoadBSI LightX, LightY, CheckFile$("CHHDLTSP.BSI")
IF Item = 82 THEN LoadBSI LightX, LightY, CheckFile$("CHHDLTSC.BSI")
IF Item = 83 THEN LoadBSI LightX, LightY, CheckFile$("CHHDLTCP.BSI")
IF Item = 84 THEN LoadBSI LightX, LightY, CheckFile$("CHHDLTCC.BSI")
DeLIGHT
Phase = 24
CASE 85 TO 87
SELECT CASE FenderSTYLE
CASE 1
IF Item = 85 THEN LoadBSI WheelRX, WheelRY, CheckFile$("CHTLLTSP.BSI")
IF Item = 86 THEN LoadBSI WheelRX, WheelRY, CheckFile$("CHTLLTSC.BSI")
IF HighPIPE = 1 THEN LoadBSI FrameX, FrameY, CheckFile$("CHExVHOS.BSI")
CASE 2
IF Item = 85 THEN LoadBSI WheelRX, WheelRY, CheckFile$("CHTLLTCP.BSI")
IF Item = 86 THEN LoadBSI WheelRX, WheelRY, CheckFile$("CHTLLTCC.BSI")
CASE 3
IF Item = 85 THEN LoadBSI WheelRX, WheelRY, CheckFile$("CHTLLTFP.BSI")
IF Item = 86 THEN LoadBSI WheelRX, WheelRY, CheckFile$("CHTLLTFC.BSI")
END SELECT
DeLIGHT
Phase = 25
END SELECT
END IF
END SUB
SUB ChopperIDE
FOR Colr = 8 TO 14
OUT &H3C8, Colr
OUT &H3C9, 63 - nn / 4
OUT &H3C9, 24 - nn
OUT &H3C9, 0
nn = nn + 4
NEXT Colr
DEF SEG = VARSEG(Box(0))
FOR y = 0 TO 320 STEP 160
FileCOUNT = FileCOUNT + 1
FileNAME$ = CheckFile$("CHIDE" + LTRIM$(STR$(FileCOUNT)) + ".BSV")
BLOAD FileNAME$, VARPTR(Box(0))
PUT (0, y), Box()
NEXT y
DEF SEG
END SUB
SUB ClearBOX
LINE (11, 295)-(628, 469), 0, BF
END SUB
SUB ClearMOUSE
WHILE LB OR RB
MouseSTATUS LB, RB, MouseX, MouseY
WEND
END SUB
SUB DeLIGHT
SHARED ItemX, ItemY
IF Item THEN
PUT (ItemX, ItemY), MenuBOX(), PSET
Item = 0
END IF
END SUB
SUB FourBIT (x1%, y1%, x2%, y2%, FileNAME$)
DIM FileCOLORS%(1 TO 48)
DIM Colors4%(15)
GraphX = 314
FOR x = x1% TO x2%
FOR y = y1% TO y2%
Colors4%(POINT(x, y)) = 1
NEXT y
LINE (GraphX, 323)-(GraphX, 331), 11
IF x MOD 11 = 0 THEN GraphX = GraphX + 1
NEXT x
FOR n = 0 TO 15
IF Colors4%(n) = 1 THEN SigCOLORS& = SigCOLORS& + 1
NEXT n
FileTYPE$ = "BM"
Reserved1% = 0
Reserved2% = 0
OffsetBITS& = 118
InfoHEADER& = 40
PictureWIDTH& = x2% - x1% + 1
PictureDEPTH& = y2% - y1% + 1
NumPLANES% = 1
BPP% = 4
Compression& = 0
WidthPELS& = 3780
DepthPELS& = 3780
NumCOLORS& = 16
IF PictureWIDTH& MOD 8 <> 0 THEN
ZeroPAD$ = SPACE$((8 - PictureWIDTH& MOD 8) \ 2)
END IF
ImageSIZE& = (((ImageWIDTH& + LEN(ZeroPAD$)) * ImageDEPTH&) + .1) / 2
FileSIZE& = ImageSIZE& + OffsetBITS&
Colr = 0
FOR n = 1 TO 48 STEP 3
OUT &H3C7, Colr
FileCOLORS%(n) = INP(&H3C9)
FileCOLORS%(n + 1) = INP(&H3C9)
FileCOLORS%(n + 2) = INP(&H3C9)
Colr = Colr + 1
NEXT n
if _fileexists(FileNAME$) then kill FileNAME$
OPEN FileNAME$ FOR BINARY AS #1
PUT #1, , FileTYPE$
PUT #1, , FileSIZE&
PUT #1, , Reserved1% 'should be zero
PUT #1, , Reserved2% 'should be zero
PUT #1, , OffsetBITS&
PUT #1, , InfoHEADER&
PUT #1, , PictureWIDTH&
PUT #1, , PictureDEPTH&
PUT #1, , NumPLANES%
PUT #1, , BPP%
PUT #1, , Compression&
PUT #1, , ImageSIZE&
PUT #1, , WidthPELS&
PUT #1, , DepthPELS&
PUT #1, , NumCOLORS&
PUT #1, , SigCOLORS&
u$ = " "
FOR n% = 1 TO 46 STEP 3
Colr$ = CHR$(FileCOLORS%(n% + 2) * 4)
PUT #1, , Colr$
Colr$ = CHR$(FileCOLORS%(n% + 1) * 4)
PUT #1, , Colr$
Colr$ = CHR$(FileCOLORS%(n%) * 4)
PUT #1, , Colr$
PUT #1, , u$ 'Unused byte
NEXT n%
FOR y = y2% TO y1% STEP -1
FOR x = x1% TO x2% STEP 2
HiX = POINT(x, y)
LoX = POINT(x + 1, y)
HiNIBBLE$ = HEX$(HiX)
LoNIBBLE$ = HEX$(LoX)
HexVAL$ = "&H" + HiNIBBLE$ + LoNIBBLE$
a$ = CHR$(VAL(HexVAL$))
PUT #1, , a$
NEXT x
PUT #1, , ZeroPAD$
IF y MOD 3 = 0 THEN
LINE (GraphX, 323)-(GraphX, 331), 11
GraphX = GraphX + 1
END IF
NEXT y
CLOSE #1
END SUB
SUB HandleBARS (InOUT)
SHARED BarX, BarY, GotBOX
IF InOUT = 0 THEN GOSUB DeBOX: EXIT SUB
SELECT CASE MouseY
CASE 332 TO 414
SELECT CASE MouseX
CASE 12 TO 87
IF BarBOX <> 1 THEN
GOSUB DeBOX
BarBOX = 1
GOSUB BoxIT
END IF
CASE 89 TO 164
IF BarBOX <> 2 THEN
GOSUB DeBOX
BarBOX = 2
GOSUB BoxIT
END IF
CASE 166 TO 241
IF BarBOX <> 3 THEN
GOSUB DeBOX
BarBOX = 3
GOSUB BoxIT
END IF
CASE 243 TO 318
IF MouseY < 374 THEN
IF BarBOX <> 4 THEN
GOSUB DeBOX
BarBOX = 4
GOSUB BoxIT
END IF
ELSE
IF BarBOX <> 5 THEN
GOSUB DeBOX
BarBOX = 5
GOSUB BoxIT
END IF
END IF
CASE 320 TO 395
IF BarBOX <> 6 THEN
GOSUB DeBOX
BarBOX = 6
GOSUB BoxIT
END IF
CASE 397 TO 472
IF BarBOX <> 7 THEN
GOSUB DeBOX
BarBOX = 7
GOSUB BoxIT
END IF
CASE 474 TO 549
IF BarBOX <> 8 THEN
GOSUB DeBOX
BarBOX = 8
GOSUB BoxIT
END IF
CASE 551 TO 626
IF BarBOX <> 9 THEN
GOSUB DeBOX
BarBOX = 9
GOSUB BoxIT
END IF
END SELECT
CASE 423 TO 439
IF MouseX > 277 AND MouseX < 349 THEN
IF LB = -1 THEN
GET (278, 423)-(358, 439), MenuBOX()
LINE (278, 423)-(358, 439), 4, BF
LINE (278, 423)-(278, 439), 3
LINE (278, 423)-(358, 423), 3
PrintSTRING 302, 426, "Accept"
Interval .1
PUT (278, 423), MenuBOX(), PSET
IF GotBOX = 1 THEN
DeLIGHT
GOSUB DeBOX
OPEN CheckFile$("CHCable.DAT") FOR INPUT AS #1
INPUT #1, xx, yy
FOR x = 0 TO xx
FOR y = 0 TO yy
INPUT #1, Colr
IF Colr <> 0 THEN
IF POINT(x + BarX - 16, y + BarY + 24) = 0 THEN
PSET (x + BarX - 16, y + BarY + 24), Colr
END IF
END IF
NEXT y
NEXT x
CLOSE #1
Phase = 22
EXIT SUB
END IF
END IF
END IF
CASE ELSE
GOSUB DeBOX
END SELECT
IF BarBOX <> 0 AND LB = -1 THEN
IF GotBOX = 1 THEN PUT (BarX - 10, BarY - 45), Box(24000), PSET: GotBOX = 0
GET (BarX - 10, BarY - 45)-(BarX + 66, BarY + 30), Box(24000): GotBOX = 1
SELECT CASE BarBOX
CASE 1: loadfile CheckFile$("CHBar1.BSI")
CASE 2: loadfile CheckFile$("CHBar2.BSI")
CASE 3: loadfile CheckFile$("CHBar3.BSI")
CASE 4: loadfile CheckFile$("CHBar4.BSI")
CASE 5: loadfile CheckFile$("CHBar5.BSI")
CASE 6: loadfile CheckFile$("CHBar6.BSI")
CASE 7: loadfile CheckFile$("CHBar7.BSI")
CASE 8: loadfile CheckFile$("CHBar8.BSI")
CASE 9: loadfile CheckFile$("CHBar9.BSI")
END SELECT
PUT (BarX - Box(0), BarY - Box(1)), Box(3), AND
PUT (BarX - Box(0), BarY - Box(1)), Box(Box(2))
END IF
EXIT SUB
DeBOX:
IF BarBOX THEN
SELECT CASE BarBOX
CASE 1: LINE (12, 332)-(87, 414), 3, B
CASE 2: LINE (89, 332)-(164, 414), 3, B
CASE 3: LINE (166, 332)-(241, 414), 3, B
CASE 4: LINE (243, 332)-(318, 372), 3, B
CASE 5: LINE (243, 374)-(318, 414), 3, B
CASE 6: LINE (320, 332)-(395, 414), 3, B
CASE 7: LINE (397, 332)-(472, 414), 3, B
CASE 8: LINE (474, 332)-(549, 414), 3, B
CASE 9: LINE (551, 332)-(626, 414), 3, B
END SELECT
BarBOX = 0
END IF
RETURN
BoxIT:
SELECT CASE BarBOX
CASE 1: LINE (12, 332)-(87, 414), 15, B
CASE 2: LINE (89, 332)-(164, 414), 15, B
CASE 3: LINE (166, 332)-(241, 414), 15, B
CASE 4: LINE (243, 332)-(318, 372), 15, B
CASE 5: LINE (243, 374)-(318, 414), 15, B
CASE 6: LINE (320, 332)-(395, 414), 15, B
CASE 7: LINE (397, 332)-(472, 414), 15, B
CASE 8: LINE (474, 332)-(549, 414), 15, B
CASE 9: LINE (551, 332)-(626, 414), 15, B
END SELECT
RETURN
END SUB
SUB HelpMENU
STATIC HelpITEM, HelpY, Instructions, CornerON
DO
MouseSTATUS LB, RB, MouseX, MouseY
IF Instructions THEN
SELECT CASE MouseX
CASE 428 TO 456
SELECT CASE MouseY
CASE 104 TO 118
IF CornerON <> 1 THEN
GOSUB LightINSTR
CornerON = 1
END IF
CASE ELSE
GOSUB DarkINSTR
END SELECT
CASE ELSE
GOSUB DarkINSTR
END SELECT
IF CornerON AND LB = -1 THEN
SELECT CASE Instructions
CASE 1
loadfile CheckFile$("CHInstr2.BSV")
Instructions = 2
PUT (180, 100), Box(), PSET
ClearMOUSE
CornerON = 0
CASE 2
PUT (180, 100), Box(13000), PSET
Instructions = 0
END SELECT
END IF
ELSE
SELECT CASE MouseX
CASE 492 TO 584
SELECT CASE MouseY
CASE 34 TO 55
GOSUB DarkHELP
IF MouseX < 500 OR MouseX > 544 THEN GOSUB CloseHELP
CASE 56 TO 71
IF HelpITEM <> 1 THEN
GOSUB DarkHELP
HelpY = 59
GOSUB LightHELP
HelpITEM = 1
END IF
CASE 72 TO 87
IF HelpITEM <> 2 THEN
GOSUB DarkHELP
HelpY = 75
GOSUB LightHELP
HelpITEM = 2
END IF
CASE ELSE: GOSUB CloseHELP
END SELECT
CASE ELSE: GOSUB CloseHELP
END SELECT
IF HelpITEM > 0 AND LB = -1 THEN
SELECT CASE HelpITEM
CASE 1
GOSUB DarkHELP
MenuITEM = 0
MenuBAR 0
GET (180, 100)-(460, 272), Box(13000)
loadfile CheckFile$("CHInstr1.BSV")
PUT (180, 100), Box(), PSET
Instructions = 1
CASE 2
GOSUB DarkHELP
MenuITEM = 0
MenuBAR 0
GET (180, 100)-(460, 272), Box(13000)
loadfile CheckFile$("CHAbout.BSV")
PUT (180, 100), Box(), PSET
Instructions = 2
END SELECT
END IF
END IF
LOOP
EXIT SUB
LightHELP:
GET (498, HelpY)-(598, HelpY + 10), MenuBOX2()
FOR x = 498 TO 598
FOR y = HelpY TO HelpY + 10
IF POINT(x, y) = 3 THEN PSET (x, y), 15
NEXT y
NEXT x
RETURN
DarkHELP:
IF HelpITEM THEN
PUT (498, HelpY), MenuBOX2(), PSET
HelpITEM = 0
END IF
RETURN
LightINSTR:
FOR x = 428 TO 456
FOR y = 104 TO 118
IF POINT(x, y) = 3 THEN PSET (x, y), 15
NEXT y
NEXT x
RETURN
DarkINSTR:
IF CornerON <> 0 THEN
FOR x = 428 TO 456
FOR y = 104 TO 118
IF POINT(x, y) = 15 THEN PSET (x, y), 3
NEXT y
NEXT x
CornerON = 0
END IF
RETURN
CloseHELP:
GOSUB DarkHELP
MenuITEM = 0
MenuBAR 0
EXIT SUB
RETURN
END SUB
SUB HiLIGHT
SHARED ItemX, ItemY
GET (ItemX, ItemY)-(ItemX + 130, ItemY + 10), MenuBOX()
FOR x = ItemX TO ItemX + 130
FOR y = ItemY TO ItemY + 10
IF POINT(x, y) <> 0 THEN PSET (x, y), 15
NEXT y
NEXT x
END SUB
DEFSNG A-Z
SUB Interval (Length!)
OldTimer# = TIMER
DO: LOOP UNTIL TIMER > OldTimer# + Length!
WAIT &H3DA, 8
END SUB
DEFINT A-Z
SUB LoadBSI (x, y, FileNAME$)
''FileNAME$ = FileNAME$ + ".BSI"
LoadFILE FileNAME$
WAIT &H3DA, 8
PUT (x + Box(0), y + Box(1)), Box(3), AND
PUT (x + Box(0), y + Box(1)), Box(Box(2))
END SUB
SUB LoadFILE (FileNAME$)
''IF INSTR(FileNAME$, ".") = 0 THEN FileNAME$ = FileNAME$ + ".BSV"
DEF SEG = VARSEG(Box(0))
BLOAD FileNAME$, VARPTR(Box(0))
DEF SEG
END SUB
SUB LoadIMAGE (x, y, FileNAME$)
''IF INSTR(FileNAME$, ".") = 0 THEN FileNAME$ = FileNAME$ + ".BSV"
DEF SEG = VARSEG(Box(0))
BLOAD FileNAME$, VARPTR(Box(0))
DEF SEG
WAIT &H3DA, 8
PUT (x, y), Box()
END SUB
SUB LoadPHASE
STATIC ExPHASE
SHARED PX, PY, Trimmed, Style, MotorSTYLE
SHARED Frame, FrameCOLOR, Extension, FenderSTYLE, BarBOX, GotBOX
IF Phase <> ExPHASE THEN
IF Phase = 1 THEN
LINE (20, 56)-(620, 200), 0, BF
LINE (90, 201)-(549, 280), 0, BF
LINE (90, 252)-(549, 280), 2, BF
END IF
ClearBOX
SELECT CASE Phase
CASE 1
BarBOX = 0: GotBOX = 0: ImageLOADED = 0
PX = 0: PY = 0: Trimmed = 0: Style = 0
BikeCOLOR = 3: FlameSTYLE = 1: SetPALETTE
LoadIMAGE 116, 300, CheckFile$("CHFrames.BSV")
CASE 2
IF Frame = 1 THEN
LoadIMAGE 18, 300, CheckFile$("CHFrmCLR.BSV")
ELSE
LoadIMAGE 18, 300, CheckFile$("CHFrmCLX.BSV")
END IF
CASE 3
SELECT CASE FrameCOLOR
CASE 1
IF Frame = 1 THEN
LoadIMAGE 112, 300, CheckFile$("CHExtRP.BSV")
ELSE
LoadIMAGE 112, 300, CheckFile$("CHExtXP.BSV")
END IF
CASE 2
IF Frame = 1 THEN
LoadIMAGE 112, 300, CheckFile$("CHExtRB.BSV")
ELSE
LoadIMAGE 112, 300, CheckFile$("CHExtXB.BSV")
END IF
CASE 3
IF Frame = 1 THEN
LoadIMAGE 112, 300, CheckFile$("CHExtRC.BSV")
ELSE
LoadIMAGE 112, 300, CheckFile$("CHExtXC.BSV")
END IF
END SELECT
CASE 4
SELECT CASE Extension
CASE 1: LoadIMAGE 53, 300, CheckFile$("CHFrksR.BSV")
CASE 2: LoadIMAGE 53, 300, CheckFile$("CHFrksX.BSV")
CASE 3: LoadIMAGE 20, 300, CheckFile$("CHFrksXX.BSV")
END SELECT
CASE 5
LoadIMAGE 89, 312, CheckFile$("CHTiresF.BSV")
CASE 6
LoadIMAGE 170, 80, CheckFile$("CHPrepAR.BSV")
IF Frame = 1 THEN
LoadIMAGE 89, 312, CheckFile$("CHTireRR.BSV")
ELSE
LoadIMAGE 89, 312, CheckFile$("CHTireRX.BSV")
END IF
CASE 7
LoadIMAGE 70, 310, CheckFile$("CHWheels.BSV")
CASE 8
LoadIMAGE 88, 305, CheckFile$("CHFndrs.BSV")
CASE 9
LoadIMAGE 140, 320, CheckFile$("CHMotors.BSV")
CASE 10
IF MotorSTYLE = 2 THEN
LoadIMAGE 144, 320, CheckFile$("CHMtrKCL.BSV")
ELSE
LoadIMAGE 144, 320, CheckFile$("CHMtrBCL.BSV")
END IF
CASE 11
LoadIMAGE 137, 320, CheckFile$("CHDrives.BSV")
CASE 12
LoadIMAGE 142, 330, CheckFile$("CHBDCvrs.BSV")
CASE 13
LoadIMAGE 118, 330, CheckFile$("CHIntaks.BSV")
CASE 14
LoadIMAGE 190, 320, CheckFile$("CHRDrvV.BSV")
CASE 15
LoadIMAGE 102, 320, CheckFile$("CHRDrv7.BSV")
CASE 16
LoadIMAGE 60, 310, CheckFile$("CHExBR.BSV")
CASE 17
LoadIMAGE 42, 310, CheckFile$("CHExVs.BSV")
CASE 18
LoadIMAGE 88, 320, CheckFile$("CHFTanks.BSV")
CASE 19
LoadIMAGE 76, 330, CheckFile$("CHOTnksR.BSV")
CASE 20
LoadIMAGE 167, 330, CheckFile$("CHOTnksX.BSV")
CASE 21
LoadIMAGE 12, 310, CheckFile$("CHHBars.BSV")
CASE 22
LoadIMAGE 38, 320, CheckFile$("CHSeats.BSV")
CASE 23
LoadIMAGE 80, 324, CheckFile$("CHHDLts.BSV")
CASE 24
SELECT CASE FenderSTYLE
CASE 1: LoadIMAGE 122, 320, CheckFile$("CHTLLTSS.BSV")
CASE 2: LoadIMAGE 122, 320, CheckFile$("CHTLLTSC.BSV")
CASE 3: LoadIMAGE 122, 320, CheckFile$("CHTLLTSF.BSV")
END SELECT
CASE 25
LoadIMAGE 20, 300, CheckFile$("CHPaint.BSV")
END SELECT
ExPHASE = Phase
END IF
END SUB
SUB MenuBAR (InOUT)
STATIC MenuX, BoxX
SHARED FFLX, FFRX, FFTY, FFBY, RFLX, RFRX, RFTY, RFBY, TX, TY
SHARED FrameX, FrameY, FenderSTYLE, HighPIPE, OT, GPaint, Frame
IF BoxX <> 0 THEN GOSUB CloseBOX
IF InOUT = 0 THEN GOSUB MenuDARK: EXIT SUB
SELECT CASE MouseX
CASE 431 TO 464
IF TopMENU <> 1 THEN
GOSUB MenuDARK
MenuX = 432
GOSUB MenuLIGHT
TopMENU = 1
END IF
CASE 513 TO 532
IF TopMENU <> 2 THEN
GOSUB MenuDARK
MenuX = 513
GOSUB MenuLIGHT
TopMENU = 2
END IF
CASE 582 TO 602
IF TopMENU <> 3 THEN
GOSUB MenuDARK
MenuX = 582
GOSUB MenuLIGHT
TopMENU = 3
END IF
CASE ELSE
GOSUB MenuDARK
END SELECT
IF TopMENU AND LB = -1 THEN
SELECT CASE TopMENU
CASE 1
GET (416, 46)-(563, 148), MenuBOX3()
loadfile CheckFile$("CHProMNU.BSV")
WAIT &H3DA, 8
PUT (416, 46), Box(), PSET
BoxX = 416
MenuITEM = 1
CASE 2
GET (472, 46)-(598, 100), MenuBOX3()
loadfile CheckFile$("CHHlpMNU.BSV")
WAIT &H3DA, 8
PUT (492, 46), Box(), PSET
BoxX = 472
MenuITEM = 2
CASE 3: GOSUB MenuDARK: SYSTEM
END SELECT
END IF
EXIT SUB
MenuLIGHT:
GET (MenuX, 34)-(MenuX + 31, 44), MenuBOX()
FOR x = MenuX TO MenuX + 31
FOR y = 34 TO 44
IF POINT(x, y) <> 1 THEN PSET (x, y), 15
NEXT y
NEXT x
RETURN
MenuDARK:
IF TopMENU THEN
PUT (MenuX, 34), MenuBOX(), PSET
TopMENU = 0
END IF
RETURN
CloseBOX:
IF BoxX THEN
PUT (BoxX, 46), MenuBOX3(), PSET
BoxX = 0
END IF
RETURN
END SUB
SUB MouseSTATUS (LB, RB, MouseX, MouseY)
WHILE _MOUSEINPUT: WEND
LB = _MOUSEBUTTON(1)
RB = _MOUSEBUTTON(2)
MouseX = _MOUSEX
MouseY = _MOUSEY
END SUB
SUB PaintSHOP (Mode)
SHARED PX, PY, Trimmed, Style
SHARED FFLX, FFRX, FFTY, FFBY, RFLX, RFRX, RFTY, RFBY, TX, TY
SHARED FrameX, FrameY, FenderSTYLE, HighPIPE, OT, GPaint, Frame
SHARED WheelFX, WheelFY, WheelRX, WheelRY, Cover, Tank, TTY, TTTY
IF Mode = 0 THEN GOSUB UnLIGHT: EXIT SUB
SELECT CASE MouseX
CASE 82 TO 106
SELECT CASE MouseY
CASE 353 TO 364
IF PaintITEM <> 1 THEN
GOSUB UnLIGHT
PX = 85: PY = 356
GOSUB LIGHT
PaintITEM = 1
END IF
CASE 367 TO 378
IF PaintITEM <> 2 THEN
GOSUB UnLIGHT
PX = 85: PY = 370
GOSUB LIGHT
PaintITEM = 2
END IF
CASE 381 TO 392
IF PaintITEM <> 3 THEN
GOSUB UnLIGHT
PX = 85: PY = 384
GOSUB LIGHT
PaintITEM = 3
END IF
CASE 395 TO 406
IF PaintITEM <> 4 THEN
GOSUB UnLIGHT
PX = 85: PY = 398
GOSUB LIGHT
PaintITEM = 4
END IF
CASE 409 TO 420
IF PaintITEM <> 5 THEN
GOSUB UnLIGHT
PX = 85: PY = 412
GOSUB LIGHT
PaintITEM = 5
END IF
CASE ELSE
GOSUB UnLIGHT
END SELECT
CASE 172 TO 196
SELECT CASE MouseY
CASE 353 TO 364
IF PaintITEM <> 6 THEN
GOSUB UnLIGHT
PX = 175: PY = 356
GOSUB LIGHT
PaintITEM = 6
END IF
CASE 367 TO 378
IF PaintITEM <> 7 THEN
GOSUB UnLIGHT
PX = 175: PY = 370
GOSUB LIGHT
PaintITEM = 7
END IF
CASE 381 TO 392
IF PaintITEM <> 8 THEN
GOSUB UnLIGHT
PX = 175: PY = 384
GOSUB LIGHT
PaintITEM = 8
END IF
CASE 395 TO 406
IF PaintITEM <> 9 THEN
GOSUB UnLIGHT
PX = 175: PY = 398
GOSUB LIGHT
PaintITEM = 9
END IF
CASE 409 TO 420
IF PaintITEM <> 10 THEN
GOSUB UnLIGHT
PX = 175: PY = 412
GOSUB LIGHT
PaintITEM = 10
END IF
CASE ELSE
GOSUB UnLIGHT
END SELECT
CASE 304 TO 328
SELECT CASE MouseY
CASE 353 TO 364
IF PaintITEM <> 11 THEN
GOSUB UnLIGHT
PX = 307: PY = 356
GOSUB LIGHT
PaintITEM = 11
END IF
CASE 367 TO 378
IF PaintITEM <> 12 THEN
GOSUB UnLIGHT
PX = 307: PY = 370
GOSUB LIGHT
PaintITEM = 12
END IF
CASE 381 TO 392
IF PaintITEM <> 13 THEN
GOSUB UnLIGHT
PX = 307: PY = 384
GOSUB LIGHT
PaintITEM = 13
END IF
CASE 409 TO 420
IF PaintITEM <> 14 THEN
GOSUB UnLIGHT
PX = 307: PY = 412
GOSUB LIGHT
PaintITEM = 14
END IF
CASE ELSE
GOSUB UnLIGHT
END SELECT
CASE 420 TO 444
SELECT CASE MouseY
CASE 353 TO 364
IF PaintITEM <> 15 THEN
GOSUB UnLIGHT
PX = 423: PY = 356
GOSUB LIGHT
PaintITEM = 15
END IF
CASE 367 TO 378
IF PaintITEM <> 16 THEN
GOSUB UnLIGHT
PX = 423: PY = 370
GOSUB LIGHT
PaintITEM = 16
END IF
CASE 381 TO 392
IF PaintITEM <> 17 THEN
GOSUB UnLIGHT
PX = 423: PY = 384
GOSUB LIGHT
PaintITEM = 17
END IF
CASE 395 TO 406
IF PaintITEM <> 18 THEN
GOSUB UnLIGHT
PX = 423: PY = 398
GOSUB LIGHT
PaintITEM = 18
END IF
CASE 409 TO 420
IF PaintITEM <> 19 THEN
GOSUB UnLIGHT
PX = 423: PY = 412
GOSUB LIGHT
PaintITEM = 19
END IF
CASE ELSE
GOSUB UnLIGHT
END SELECT
CASE ELSE
GOSUB UnLIGHT
END SELECT
IF PaintITEM AND LB = -1 THEN
SELECT CASE PaintITEM
CASE 1 TO 10: BikeCOLOR = PaintITEM - 1: SetPALETTE
CASE 11
IF Style <> 1 THEN
IF Frame = 1 AND Tank = 2 THEN TTTY = -6
GOSUB NoTRIM
OPEN CheckFile$("FF.DAT") FOR INPUT AS #1
SELECT CASE FenderSTYLE
CASE 1: OPEN CheckFile$("FFSF.DAT") FOR INPUT AS #2
CASE 2: OPEN CheckFile$("FFCF.DAT") FOR INPUT AS #2
CASE 3: OPEN CheckFile$("FFFF.DAT") FOR INPUT AS #2
END SELECT
OPEN "FFW.DAT" FOR OUTPUT AS #3
INPUT #1, x1, xx, y1, yy
WRITE #3, x1, xx, y1, yy
FOR x = x1 TO x1 + xx
FOR y = y1 TO y1 + yy
INPUT #1, Value
INPUT #2, Colr
WRITE #3, POINT(x, y)
IF Value = 1 AND Colr <> 0 THEN PSET (x, y), Colr
NEXT y
NEXT x
CLOSE #1, #2, #3
OPEN CheckFile$("FTnkF.DTI") FOR INPUT AS #1
OPEN "TNKW.DAT" FOR OUTPUT AS #2
INPUT #1, x1, xx, y1, yy
x1 = FrameX + x1 + TX
y1 = FrameY + y1 + TY + TTTY
WRITE #2, x1, xx, y1, yy
FOR x = x1 TO x1 + xx
FOR y = y1 TO y1 + yy
WRITE #2, POINT(x, y)
INPUT #1, Colr
IF Colr <> 0 THEN
IF POINT(x, y) = 6 OR POINT(x, y) = 7 OR POINT(x, y) = 13 THEN PSET (x, y), Colr
END IF
NEXT y
NEXT x
CLOSE #1, #2
IF Cover THEN
OPEN CheckFile$("DCPB.DAT") FOR INPUT AS #1
OPEN "DCW.DAT" FOR OUTPUT AS #2
INPUT #1, x1, xx, y1, yy
x1 = FrameX + x1
y1 = FrameY + y1
WRITE #2, x1, xx, y1, yy
FOR x = x1 TO x1 + xx
FOR y = y1 TO y1 + yy
WRITE #2, POINT(x, y)
INPUT #1, Colr
IF Colr <> 0 THEN
IF POINT(x, y) = 6 OR POINT(x, y) = 7 OR POINT(x, y) = 10 THEN PSET (x, y), Colr
END IF
NEXT y
NEXT x
CLOSE #1, #2
END IF
GOSUB OilTANK
OPEN CheckFile$("RF.DAT") FOR INPUT AS #1
SELECT CASE FenderSTYLE
CASE 1
IF OT = 5 THEN
OPEN CheckFile$("RFSRFB.DAT") FOR INPUT AS #2
ELSE
IF GPaint = 1 OR FenderSTYLE = 1 THEN
IF Frame = 1 THEN
OPEN CheckFile$("RFSRCG.DAT") FOR INPUT AS #2
ELSE
OPEN CheckFile$("RFSXCG.DAT") FOR INPUT AS #2
END IF
ELSE
OPEN CheckFile$("RFS.DAT") FOR INPUT AS #2
END IF
END IF
CASE 2
IF OT = 5 THEN
OPEN CheckFile$("RFCRFB.DAT") FOR INPUT AS #2
ELSE
IF GPaint = 1 THEN
IF Frame = 1 THEN
OPEN CheckFile$("RFCRCG.DAT") FOR INPUT AS #2
ELSE
OPEN CheckFile$("RFCXCG.DAT") FOR INPUT AS #2
END IF
ELSE
OPEN CheckFile$("RFC.DAT") FOR INPUT AS #2
END IF
END IF
CASE 3: OPEN CheckFile$("RFF.DAT") FOR INPUT AS #2
END SELECT
OPEN "RFW.DAT" FOR OUTPUT AS #3
INPUT #1, x1, xx, y1, yy
WRITE #3, x1, xx, y1, yy
FOR x = x1 TO x1 + xx
FOR y = y1 TO y1 + yy
INPUT #1, Value
INPUT #2, Colr
IF POINT(x, y) = 8 OR POINT(x, y) = 12 OR POINT(x, y) = 14 THEN
WRITE #3, 7
ELSE
WRITE #3, POINT(x, y)
END IF
IF POINT(x, y) = 7 OR POINT(x, y) = 6 THEN
IF Value = 1 AND Colr <> 0 THEN PSET (x, y), Colr
END IF
NEXT y
NEXT x
CLOSE #1, #2, #3
Trimmed = 1
Style = 1
END IF
CASE 12
IF Style <> 2 THEN
IF Frame = 1 AND Tank = 2 THEN TTTY = -6
GOSUB NoTRIM
OPEN CheckFile$("FTnkF2.DTI") FOR INPUT AS #1
OPEN "TNKW.DAT" FOR OUTPUT AS #2
INPUT #1, xx, yy
x1 = FrameX + 30 + TX
y1 = FrameY + 12 + TY + TTTY
WRITE #2, x1, xx, y1, yy
FOR x = 0 TO xx
FOR y = 0 TO yy
WRITE #2, POINT(x + x1, y + y1)
INPUT #1, Colr
IF Colr <> 0 THEN
IF POINT(x + x1, y + y1) = 6 OR POINT(x + x1, y + y1) = 7 OR POINT(x + x1, y + y1) = 13 THEN PSET (x + x1, y + y1), Colr
END IF
NEXT y
NEXT x
CLOSE #1, #2
IF Cover THEN
OPEN CheckFile$("DrCvrF2.DTI") FOR INPUT AS #1
OPEN "CVRW.DAT" FOR OUTPUT AS #2
INPUT #1, xx, yy
x1 = FrameX + 74
y1 = FrameY + 101
WRITE #2, x1, xx, y1, yy
FOR x = 0 TO xx
FOR y = 0 TO yy
WRITE #2, POINT(x + x1, y + y1)
INPUT #1, Colr
IF Colr <> 0 THEN
IF POINT(x + x1, y + y1) > 5 AND POINT(x + x1, y + y1) < 11 THEN PSET (x + x1, y + y1), Colr
END IF
NEXT y
NEXT x
CLOSE #1, #2
END IF
Style = 2
Trimmed = 1
END IF
CASE 13
IF Style <> 3 THEN
GOSUB NoTRIM
SELECT CASE FenderSTYLE
CASE 1: OPEN CheckFile$("FFSP.DAT") FOR INPUT AS #1
CASE 2: OPEN CheckFile$("FFCP.DAT") FOR INPUT AS #1
CASE 3: OPEN CheckFile$("FFFP.DAT") FOR INPUT AS #1
END SELECT
OPEN CheckFile$("FF.DAT") FOR INPUT AS #2
OPEN "FFW.DAT" FOR OUTPUT AS #3
INPUT #2, x1, xx, y1, yy
WRITE #3, x1, xx, y1, yy
FOR x = x1 TO x1 + xx
FOR y = y1 TO y1 + yy
WRITE #3, POINT(x, y)
INPUT #1, Colr
INPUT #2, Value
IF Value = 1 THEN
IF Colr <> 0 THEN PSET (x, y), Colr
END IF
NEXT y
NEXT x
CLOSE #1, #2, #3
IF Frame = 1 THEN
OPEN CheckFile$("DTR.DAT") FOR INPUT AS #1
ELSE
OPEN CheckFile$("DTX.DAT") FOR INPUT AS #1
END IF
OPEN "DTW.DAT" FOR OUTPUT AS #2
INPUT #1, x1, xx, y1, yy
x1 = FrameX + x1
y1 = FrameY + y1
WRITE #2, x1, xx, y1, yy
FOR x = x1 TO x1 + xx
FOR y = y1 TO y1 + yy
WRITE #2, POINT(x, y)
INPUT #1, Colr
IF Colr <> 0 THEN
IF POINT(x, y) = 6 OR POINT(x, y) = 7 OR POINT(x, y) = 13 THEN PSET (x, y), Colr
END IF
NEXT y
NEXT x
CLOSE #1, #2
SELECT CASE Tank
CASE 1: OPEN CheckFile$("FTnkTDP.DAT") FOR INPUT AS #1
CASE 2: OPEN CheckFile$("FTnkSCP.DAT") FOR INPUT AS #1
CASE 3: OPEN CheckFile$("FTnkOSP.DAT") FOR INPUT AS #1
CASE 4: OPEN CheckFile$("FTnkCBP.DAT") FOR INPUT AS #1
CASE 5: OPEN CheckFile$("FTnkBRP.DAT") FOR INPUT AS #1
END SELECT
OPEN "TNKW.DAT" FOR OUTPUT AS #2
INPUT #1, x1, xx, y1, yy
x1 = x1 + FrameX
y1 = y1 + FrameY + TTY
WRITE #2, x1, xx, y1, yy
FOR x = x1 TO x1 + xx
FOR y = y1 TO y1 + yy
WRITE #2, POINT(x, y)
INPUT #1, Colr
IF Colr <> 0 THEN
IF POINT(x, y) = 6 OR POINT(x, y) = 7 OR POINT(x, y) = 13 THEN PSET (x, y), Colr
END IF
NEXT y
NEXT x
CLOSE #1, #2
IF Cover THEN
OPEN CheckFile$("DCPB.DAT") FOR INPUT AS #1
OPEN "DCW.DAT" FOR OUTPUT AS #2
INPUT #1, x1, xx, y1, yy
x1 = FrameX + x1
y1 = FrameY + y1
WRITE #2, x1, xx, y1, yy
FOR x = x1 TO x1 + xx
FOR y = y1 TO y1 + yy
WRITE #2, POINT(x, y)
INPUT #1, Colr
IF Colr <> 0 THEN
IF POINT(x, y) = 6 OR POINT(x, y) = 7 OR POINT(x, y) = 10 THEN PSET (x, y), Colr
END IF
NEXT y
NEXT x
CLOSE #1, #2
END IF
GOSUB OilTANK
SELECT CASE FenderSTYLE
CASE 1: OPEN CheckFile$("RFSP.DAT") FOR INPUT AS #1
CASE 2: OPEN CheckFile$("RFCP.DAT") FOR INPUT AS #1
CASE 3: OPEN CheckFile$("RFFP.DAT") FOR INPUT AS #1
END SELECT
OPEN CheckFile$("RF.DAT") FOR INPUT AS #2
OPEN "RFW.DAT" FOR OUTPUT AS #3
INPUT #2, x1, xx, y1, yy
WRITE #3, x1, xx, y1, yy
FOR x = x1 TO x1 + xx
FOR y = y1 TO y1 + yy
IF POINT(x, y) = 8 OR POINT(x, y) = 12 OR POINT(x, y) = 14 THEN
WRITE #3, 7
ELSE
WRITE #3, POINT(x, y)
END IF
INPUT #1, Colr
INPUT #2, Value
IF Value = 1 THEN
IF Colr <> 0 THEN
IF POINT(x, y) = 6 OR POINT(x, y) = 7 OR POINT(x, y) = 13 THEN PSET (x, y), Colr
END IF
END IF
NEXT y
NEXT x
CLOSE #1, #2, #3
Style = 3
Trimmed = 1
END IF
CASE 14
GOSUB NoTRIM
CASE 15: FlameSTYLE = 1: SetPALETTE
CASE 16: FlameSTYLE = 0: SetPALETTE
CASE 17: FlameSTYLE = 2: SetPALETTE
CASE 18: FlameSTYLE = 3: SetPALETTE
CASE 19: FlameSTYLE = 4: SetPALETTE
END SELECT
END IF
EXIT SUB
UnLIGHT:
IF PaintITEM THEN
PUT (PX, PY), MenuBOX(), PSET
PaintITEM = 0
END IF
RETURN
LIGHT:
GET (PX, PY)-(PX + 18, PY + 5), MenuBOX()
LINE (PX + 1, PY + 1)-(PX + 17, PY + 4), 15, BF
RETURN
NoTRIM:
IF Trimmed THEN
SELECT CASE Style
CASE 1
OPEN CheckFile$("FFW.DAT") FOR INPUT AS #1
GOSUB FileDAT
CLOSE #1
OPEN CheckFile$("TnkW.DAT") FOR INPUT AS #1
GOSUB FileDAT
CLOSE #1
IF Cover THEN
OPEN CheckFile$("DCW.DAT") FOR INPUT AS #1
GOSUB FileDAT
CLOSE #1
END IF
IF OT = 1 OR OT = 3 OR OT = 5 THEN
OPEN CheckFile$("OTW.DAT") FOR INPUT AS #1
GOSUB FileDAT
CLOSE #1
END IF
OPEN CheckFile$("RFW.DAT") FOR INPUT AS #1
GOSUB FileDAT
CLOSE #1
CASE 2
OPEN CheckFile$("TnkW.DAT") FOR INPUT AS #1
GOSUB FileDAT
CLOSE #1
IF Cover THEN
OPEN CheckFile$("DCW.DAT") FOR INPUT AS #1
GOSUB FileDAT
CLOSE #1
END IF
IF OT = 1 OR OT = 3 OR OT = 5 THEN
OPEN CheckFile$("OTW.DAT") FOR INPUT AS #1
GOSUB FileDAT
CLOSE #1
END IF
CASE 3
OPEN CheckFile$("FFW.DAT") FOR INPUT AS #1
GOSUB FileDAT
CLOSE #1
OPEN CheckFile$("DTW.DAT") FOR INPUT AS #1
GOSUB FileDAT
CLOSE #1
OPEN CheckFile$("TnkW.DAT") FOR INPUT AS #1
GOSUB FileDAT
CLOSE #1
IF Cover THEN
OPEN CheckFile$("DCW.DAT") FOR INPUT AS #1
GOSUB FileDAT
CLOSE #1
END IF
IF OT = 1 OR OT = 3 OR OT = 5 THEN
OPEN CheckFile$("OTW.DAT") FOR INPUT AS #1
GOSUB FileDAT
CLOSE #1
END IF
OPEN CheckFile$("RFW.DAT") FOR INPUT AS #1
GOSUB FileDAT
CLOSE #1
END SELECT
Trimmed = 0
Style = 0
END IF
RETURN
OilTANK:
IF OT = 1 OR OT = 3 OR OT = 5 THEN
IF OT = 1 THEN
OPEN CheckFile$("OTH.DAT") FOR INPUT AS #1
INPUT #1, x1, xx, y1, yy
END IF
IF OT = 3 THEN
OPEN CheckFile$("OTC.DAT") FOR INPUT AS #1
INPUT #1, x1, xx, y1, yy
END IF
IF OT = 5 THEN
OPEN CheckFile$("OTBP.DAT") FOR INPUT AS #1
INPUT #1, x1, xx, y1, yy
END IF
OPEN "OTW.DAT" FOR OUTPUT AS #2
x1 = FrameX + x1
y1 = FrameY + y1
WRITE #2, x1, xx, y1, yy
FOR x = x1 TO x1 + xx
FOR y = y1 TO y1 + yy
WRITE #2, POINT(x, y)
INPUT #1, Colr
IF Colr <> 0 THEN
IF POINT(x, y) = 6 OR POINT(x, y) = 7 OR POINT(x, y) = 13 THEN PSET (x, y), Colr
END IF
NEXT y
NEXT x
CLOSE #1, #2
END IF
RETURN
FileDAT:
INPUT #1, x1, xx, y1, yy
FOR x = x1 TO x1 + xx
FOR y = y1 TO y1 + yy
INPUT #1, Colr
PSET (x, y), Colr
NEXT y
NEXT x
RETURN
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 PrintSTRING (x, y, Prnt$)
DEF SEG = VARSEG(Box(0))
BLOAD CheckFile$("CHMSSR.FBS"), VARPTR(Box(0))
DEF SEG
FOR i = 1 TO LEN(Prnt$)
Char$ = MID$(Prnt$, i, 1)
IF Char$ = " " THEN
x = x + Box(1)
ELSE
Index = (ASC(Char$) - 33) * Box(0) + 2
PUT (x, y), Box(Index)
x = x + Box(Index)
END IF
NEXT i
END SUB
SUB ProjectMENU
STATIC ProITEM, ProY
DO
MouseSTATUS LB, RB, MouseX, MouseY
SELECT CASE MouseX
CASE 423 TO 552
SELECT CASE MouseY
CASE 34 TO 55
GOSUB DarkPRO
IF MouseX > 464 THEN GOSUB ClosePRO
CASE 56 TO 71
IF ProITEM <> 1 THEN
GOSUB DarkPRO
ProY = 59
GOSUB LightPRO
ProITEM = 1
END IF
CASE 72 TO 87
IF ProITEM <> 2 THEN
GOSUB DarkPRO
ProY = 75
GOSUB LightPRO
ProITEM = 2
END IF
CASE ELSE: GOSUB ClosePRO
END SELECT
CASE ELSE: GOSUB ClosePRO
END SELECT
IF ProITEM <> 0 AND LB = -1 THEN
SELECT CASE ProITEM
CASE 1
Phase = 1
GOSUB ClosePRO
CASE 2
GOSUB DarkPRO
MenuITEM = 0
MenuBAR 0
GET (178, 60)-(460, 152), Box(10000)
loadfile CheckFile$("CHSaveBM.BSV")
PUT (178, 60), Box(), PSET
GOSUB GetNAME
PUT (178, 60), Box(10000), PSET
IF LEN(FileNAME$) THEN
FileNAME$ = LTRIM$(RTRIM$(FileNAME$))
IF INSTR(FileNAME$, " ") OR LEN(FileNAME$) > 8 THEN
LongNAME = 1
LongFILENAME$ = FileNAME$ + ".BMP"
FOR n = 1 TO LEN(FileNAME$)
Char$ = MID$(FileNAME$, n, 1)
IF Char$ <> " " THEN NewFILENAME$ = NewFILENAME$ + Char$
NEXT n
FileNAME$ = RTRIM$(LEFT$(NewFILENAME$, 6)) + "~1"
FileNAME$ = FileNAME$ + ".TBM"
ELSE
FileNAME$ = FileNAME$ + ".BMP"
END IF
GET (90, 250)-(549, 348), Box(5000)
LINE (90, 250)-(100, 310), 0, BF
LINE (539, 250)-(549, 310), 0, BF
LINE (90, 285)-(549, 310), 0, BF
LINE (95, 55)-(544, 305), 3, B
LINE (115, 310)-(524, 348), 0, BF
loadfile CheckFile$("CHGenBMP.BSV")
PUT (90, 310), Box(), PSET
FILENAME$ = lcase$(FILENAME$)
LongFILENAME$ = lcase$(LongFILENAME$)
FourBIT 90, 50, 549, 310, FileNAME$
LINE (95, 55)-(544, 305), 0, B
PUT (90, 250), Box(5000), PSET
IF LongNAME = 1 THEN
$IF WIN THEN
SHELL "REN " + FileNAME$ + " TMP.TBM"
SHELL "REN TMP.TBM " + CHR$(34) + LongFILENAME$ + CHR$(34)
$ELSE
SHELL "mv " + CheckFile$(FileNAME$) + " TMP.TBM"
SHELL "mv TMP.TBM " + CHR$(34) + LongFILENAME$ + CHR$(34)
$END IF
LongNAME = 0
END IF
END IF
EXIT SUB
END SELECT
END IF
LOOP
EXIT SUB
LightPRO:
GET (430, ProY)-(560, ProY + 10), MenuBOX2()
FOR x = 430 TO 560
FOR y = ProY TO ProY + 10
IF POINT(x, y) = 3 THEN PSET (x, y), 15
NEXT y
NEXT x
RETURN
DarkPRO:
IF ProITEM THEN
PUT (430, ProY), MenuBOX2(), PSET
ProITEM = 0
END IF
RETURN
ClosePRO:
GOSUB DarkPRO
MenuITEM = 0
MenuBAR 0
EXIT SUB
RETURN
GetNAME:
CheckCHAR$ = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz "
n$ = "": ky$ = "": PrintX = 242: CharNUM = 1
DO
MouseSTATUS LB, RB, MouseX, MouseY
ky$ = INKEY$
LINE (PrintX + 2, 118)-(PrintX + 2, 128), 5
IF LEN(ky$) THEN
SELECT CASE ASC(ky$)
CASE 8
IF LEN(n$) > 0 THEN
CharNUM = CharNUM - 1
LINE (FChar(CharNUM), 118)-(PrintX + 2, 129), 15, BF
PrintX = FChar(CharNUM)
n$ = MID$(n$, 1, LEN(n$) - 1)
LINE (PrintX + 2, 118)-(PrintX + 2, 128), 5
END IF
CASE 13
FileNAME$ = n$
n$ = ""
ky$ = ""
RETURN
CASE ELSE
IF INSTR(CheckCHAR$, ky$) THEN
IF PrintX < 390 THEN
FChar(CharNUM) = PrintX
CharNUM = CharNUM + 1
LINE (PrintX + 2, 118)-(PrintX + 2, 128), 15
PrintSTRING PrintX, 118, ky$
LINE (PrintX + 2, 118)-(PrintX + 2, 128), 5
n$ = n$ + ky$
END IF
END IF
END SELECT
END IF
LOOP
RETURN
END SUB
FUNCTION Seeker (x, y, Mode)
SELECT CASE Mode
CASE 0 'left side
FOR xx = x TO x + 140
FOR yy = y TO y + 100
IF POINT(xx, yy) = 6 OR POINT(xx, yy) = 7 THEN Seeker = xx: EXIT FUNCTION
NEXT yy
NEXT xx
CASE 1 'right side
FOR xx = x + 140 TO x STEP -1
FOR yy = y TO y + 100
IF POINT(xx, yy) = 6 OR POINT(xx, yy) = 7 THEN Seeker = xx: EXIT FUNCTION
NEXT yy
NEXT xx
CASE 2 'top
FOR yy = y TO y + 100
FOR xx = x TO x + 140
IF POINT(xx, yy) = 6 OR POINT(xx, yy) = 7 THEN Seeker = yy: EXIT FUNCTION
NEXT xx
NEXT yy
CASE 3 'bottom
FOR yy = y + 100 TO y STEP -1
FOR xx = x TO x + 140
IF POINT(xx, yy) = 6 OR POINT(xx, yy) = 7 THEN Seeker = yy: EXIT FUNCTION
NEXT xx
NEXT yy
END SELECT
END FUNCTION
SUB SetPALETTE
RESTORE PaletteDATA
OUT &H3C8, 0
FOR n = 1 TO 18
READ Colr
OUT &H3C9, Colr
NEXT n
RESTORE CustomCOLORS
REDIM Colors(6)
FOR n = 0 TO 6
READ Colors(n)
NEXT n
CColor = 0
FOR n = 0 TO 6
OUT &H3C8, Colors(n)
FOR i = 1 TO 3
OUT &H3C9, CustomCOLORS(BikeCOLOR, CColor)
CColor = CColor + 1
NEXT i
NEXT n
IF FlameSTYLE THEN
SELECT CASE FlameSTYLE
CASE 1: RESTORE FlameCOLOR
CASE 2: RESTORE SilverCOLOR
CASE 3: RESTORE GoldCOLOR
CASE 4: RESTORE WhiteCOLOR
END SELECT
OUT &H3C8, 8
FOR i = 1 TO 3
READ Colr: OUT &H3C9, Colr
NEXT i
OUT &H3C8, 12
FOR i = 1 TO 3
READ Colr: OUT &H3C9, Colr
NEXT i
OUT &H3C8, 14
FOR i = 1 TO 3
READ Colr: OUT &H3C9, Colr
NEXT i
END IF
OUT &H3C8, 9: OUT &H3C9, 21: OUT &H3C9, 21: OUT &H3C9, 63
OUT &H3C8, 11: OUT &H3C9, 63: OUT &H3C9, 0: OUT &H3C9, 0
END SUB
SUB Tire (x, y, Outer, Inner)
CIRCLE (x, y), Outer, 2
CIRCLE STEP(0, 0), Inner, 2
PaintSPOT = Outer - 4
PAINT (x, y - PaintSPOT), 1, 2
CIRCLE (x, y), Outer, 1
CIRCLE (x, y), Outer - 1, 2, 30 * Degree!, 210 * Degree!
CIRCLE (x, y), Outer - 3, 2, 30 * Degree!, 210 * Degree!
Tread x, y, Outer - 1, 120, 300, 5
Tread x, y, Outer - 3, 120, 300, 5
Tread x, y, Outer - 1, 300, 475, 2
Tread x, y, Outer - 3, 300, 475, 2
IF Outer - Inner > 14 THEN
CIRCLE (x, y), Outer - 6, 2, 30 * Degree!, 210 * Degree!
Tread x, y, Outer - 6, 120, 300, 5
Tread x, y, Outer - 6, 300, 475, 2
END IF
END SUB
SUB Tread (x, y, Radius, StartDEG, StopDEG, Colr)
FOR n = StartDEG TO StopDEG STEP 5
Adj = Radius * SIN(n * Degree!)
Opp = Radius * COS(n * Degree!)
PSET (x + Adj, y + Opp), Colr
NEXT n
END SUB
FUNCTION CheckFile$ (a$)
$IF WIN THEN
CheckFile$ = a$
$ELSE
STATIC b$
b$ = lcase$(a$)
if not _fileexists(b$) then
b$ = ucase$(a$)
if not _fileexists(b$) then
print "There is an error in the program with requested file:"
print a$
end
end if
end if
CheckFile$ = b$
$END IF
END FUNCTIONBoy was this a read-end hurting for about an hour, modifying it so it works on Linux.
The following files will have to be renamed to lowercase as shown or it will not work:
chfndrfc.bsv
chfndrff.bsv
chfndrfs.bsv
chfndrrc.bsv
chfndrrf.bsv
chfndrrs.bsv
chotnkbc.bsi
chotnkbp.bsi
chotnkcc.bsi
chotnkcp.bsi
chotnkhc.bsi
chotnkhp.bsi
chstoshp.bsi
chstoshs.bsi
chstoslp.bsi
chstosls.bsi
I discovered "chops.dat" isn't even used by this program.
Basically what I did was force a "CheckFile$()" function that looks for a file whose name is either all in lowercase or all in uppercase. So a data filename that had mixed letter case was renamed as I've already explained (except a few like "chopper.ico" because somebody else did that already), while the rest including the DAT files saved by the program are in uppercase. There is a portion which does a "SHELL" to change from DOS 8-dot-3 to Windows.LFN which might have to be tested. For me as the program stands it creates a BMP file successfully. This program seems to have a bug in which it ignores mouse button presses for the coloring options, like "pinstriped", on the right-hand side at the bottom.
RE: Discussion Board for the Collection of Graphic Programs by TheBOB. - james2464 - 12-07-2022
Would this be a good place to ask questions about Bob's programs? (if not, please advise)
I just checked out StarBusters and I was very surprised to find .DWG files used. I've only ever seen this type of file when using CAD or CAM software related to my job of cnc machining. I opened one of the files and it's just a list of numbers, with quite a range of values. In the program it uses this in a way I don't really understand.
I realize this may be an older method of achieving something that happens easily in QB64, making it more or less obsolete. But having used .DWG files that contain engineering drawings I'm still curious how this works with Qbasic or QB64.
The file was read into the program into a variable ship1(n) which was defined as ship1(1400) :
Code: (Select All)
Open "BusterS1.DWG" For Input As #1
Do While Not EOF(1)
Input #1, Ship1(n)
n = n + 1
Loop
Close #1
n = 0This program uses a bunch of .DWG files but this was the first example. After reading this file it then only seems to use it in this way:
Code: (Select All)
Put (258, 100), Ship1()I'm assuming this is a more manual method of doing what _Putimage does. Is that correct? Also I don't think I've seen empty () parentheses used...so that was a surprise as well. I assume that means "all the contents" of the array.
RE: Discussion Board for the Collection of Graphic Programs by TheBOB. - mnrvovrfc - 12-07-2022
Remember that TheBob did his programs in QuickBASIC or QBasic which didn't have "_PUTIMAGE" and other commands you're seeing in QB64(PE). Must put "(PE)" in parenthesis although I don't like it, but I mean the "qb64-dot-com" version as well as Phoenix Edition of QB64. Remotely, also the old "Galleondragon" version and a few others.
The empty parenthesis shouldn't be necessary in "PUT" clause. Probably Q(uick)BASIC didn't like it.
Maybe TheBob chose some file suffixes "carelessly", ie. there was no way for him to know which application supported which file suffix. Like years ago I came across a program that saved in WRK format, while that was something recognizable by Cakewalk music software a long time ago, and if I'm not mistaken was also the first Lotus123 file format. No I am mistaken for the latter it was "WKS", but "WRK" was used by some other commercial app for Windows.
EDIT: That "DWG" file is actually a sprite created by another program written by TheBob. He didn't feel like doing like "Kong" program, creating another program just to draw the screen elements and expecting the user to run it only to get sprites for the game.
EDIT 2: I think TheBob would be pretty frustrated with QB64 if he wanted to get away from "DIM", "GET" and "PUT" to deal with sprites. Instead of inefficiently creating an array for a sprite, just load it from a file and it's identified only with a long-integer variable. Much simpler. No need to codify with text files and other such business. It even supports graphics modes beyond capabilities of "SCREEN 13".
If you downloaded the "three-dee world game" that MasterGy came up with you should see several directories sprinkled with text files. The contents are somewhat random, according to the purposes of the components of his program. TheBob actually did the same thing with some of the text files. Otherwise a few binary files were created which should be graphic sprites.
https://staging.qb64phoenix.com/showthread.php?tid=1131
RE: Discussion Board for the Collection of Graphic Programs by TheBOB. - james2464 - 12-07-2022
Thanks for explaining! I wonder if Bob used some CAD software to draw images and then found a way to use them in Qbasic. Anyway it seems my questions are mostly due to the technique differences from now vs 15-20 years ago.
Either way it's still a great reference to have Bob's programs to study. His graphics are impressive, especially given the extra steps needed to make that possible on those systems.