Enpä sitten tiedä, minne tämä olisipitänyt tunkea. Pelasin MBnetin net.nyt-blogia, ja törmäsin hauskaan jousiammuntapeliin, joten päätin tehdä siitä QB-version. Tämä on vielä hieman kesken (ei osumantarkastusta ym), mutta toimii. Lisäksi tässä on muutamia grafiikkaan ja järjestelmään liittyviä vinkkejä ja funktioita; Eli minne olisi pitänyt tunkea? Tässä vielä kaikki sisältö:
Hiiri ja järjestelmä:
MouseInit, MouseDriver, MouseHide, MouseShow, MousePut ja MouseStatus: ASM-kieliseen koodinpätkään perustuva hiiren hallinta; koodi on data-lausekkeessa.
MakeDataImage: Tallentaa GET:llä otetun kuvan jonkin tiedoston perään APPEND:lla, ja sitten kuva voidaan lukea datasta käyttäen RESTORE:a ja READ:ia.
Delay: toimii kuten C/C++:n delay, eli odottaa tietyn monta sadasosasekuntia.
Grafiikka:
DotLine, piirtää viivaa tietyllä värillä, mutta VAIN toisen, tietyn värin päälle. Tämä perustuu funktioon CountAngleMov, joka laskee kulmakertoimet viivalle.
Tähän olen vajonnut... jousiammuntaa luolastossa >D
DECLARE FUNCTION flyarrow! (x1 AS INTEGER, y1 AS INTEGER, x2 AS INTEGER, y2 AS INTEGER)
DECLARE FUNCTION ishit! (x AS INTEGER, y AS INTEGER)
DECLARE SUB delay (sec AS INTEGER)
DECLARE SUB dotline (x1 AS INTEGER, y1 AS INTEGER, x2 AS INTEGER, y2 AS INTEGER, col1 AS INTEGER, col2 AS INTEGER)
DECLARE SUB makekentta ()
DECLARE SUB mousehide ()
DECLARE FUNCTION countanglemov! (x AS INTEGER, y AS INTEGER, kx AS INTEGER, ky AS INTEGER, xm AS SINGLE, ym AS SINGLE)
DECLARE FUNCTION MouseInit! ()
DECLARE SUB mousestatus ()
DECLARE SUB MouseDriver (AX%, BX%, CX%, DX%)
DECLARE SUB mouseshow ()
DECLARE SUB MakeDataImage (kuva() AS INTEGER, filu AS STRING, nimi AS STRING)
CONST gravity = .0021, false = 0, true = NOT 0
CONST arrowlen = 10, maxkesto = 5
TYPE ukkotype
x AS INTEGER
y AS INTEGER
kesto AS INTEGER
END TYPE
TYPE ampumatype
x1 AS INTEGER
y1 AS INTEGER
x2 AS INTEGER
y2 AS INTEGER
END TYPE
DIM SHARED ukkeli(258) AS INTEGER 'ukkelin koko = 16x32
DIM a AS INTEGER, str AS STRING, i AS INTEGER 'yleisiä silmukkoja ym varten
DIM xm AS SINGLE 'nuolen lähtö xm (ukon kumpi puoli?)
DIM SHARED ukot(2) AS ukkotype, mousedown AS INTEGER, ampuma AS ampumatype
DIM voima AS INTEGER, kkey AS STRING, vuoro AS INTEGER
DIM SHARED sadasosasekunti AS LONG
PRINT "Odota. Lasketaan sekunteja...";
xm = TIMER
DO
LOCATE 1, 1: PRINT STR$(sadasosasekunti)
sadasosasekunti = sadasosasekunti + 1
IF TIMER - xm >= 1 THEN EXIT DO 'odotetaan sekunnin eroa
LOOP
sadasosasekunti = sadasosasekunti / 100
PRINT "OK"
RANDOMIZE TIMER
RESTORE imgdataukkeli
FOR a = 0 TO 257
READ ukkeli(a)
NEXT a
'Hiiren tekniset tiedot
CONST MOUSE.LEFT = 1
CONST MOUSE.RIGHT = 2
DIM SHARED mouse$, mouse.x AS INTEGER, mouse.y AS INTEGER, mouse.button AS INTEGER
RESTORE datahiiri 'Ladataan hiiri
DIM h AS STRING
mouse$ = SPACE$(57)
FOR i = 1 TO 57
READ str
h = CHR$(VAL("&H" + str))
MID$(mouse$, i, 1) = h
NEXT i
a = MouseInit
IF NOT a THEN
PRINT "Hiirtä ei löydy..."
END
END IF
SCREEN 13
makekentta
mouseshow
DO
kkey = INKEY$
IF kkey = CHR$(27) THEN EXIT DO
mousestatus
delay 20
IF (mouse.button AND 1) AND NOT mousedown THEN 'nappi pohjaan
mousedown = true
ampuma.x1 = mouse.x: ampuma.y1 = mouse.y
ampuma.x2 = mouse.x: ampuma.y2 = mouse.y
ELSEIF mousedown AND (mouse.button AND 1) THEN 'liikutaan nappi pohjassa
mousehide
dotline ampuma.x1, ampuma.y1, ampuma.x2, ampuma.y2, 2, 0
ampuma.x2 = mouse.x: ampuma.y2 = mouse.y
dotline ampuma.x1, ampuma.y1, ampuma.x2, ampuma.y2, 0, 2
mouseshow
ELSEIF mousedown AND NOT (mouse.button AND 1) THEN 'nostetaan nappia
mousehide
'Piilotetaan tähtäysviiva
dotline ampuma.x1, ampuma.y1, ampuma.x2, ampuma.y2, 2, 0
IF ampuma.x1 < ampuma.x2 THEN xm = 20 ELSE xm = -2 'kuumlata puolelta ukkelia?
a = flyarrow(ukot(vuoro).x + xm, ukot(vuoro).y + 16, ukot(vuoro).x - ampuma.x1 + ampuma.x2, ukot(vuoro).y - ampuma.y1 + ampuma.y2)
IF a THEN 'tapettiin toinen (voittaja on siis nyt vuoro-muuttujassa)
PRINT "Pelaaja" + STR$(vuoro + 1) + " voitti!"
DRAW "bm" + STR$(ukot(vuoro).x) + "," + STR$(ukot(vuoro).y - 2)
DRAW "c14r16u3l16d2u3h2u2f3e3f3r2e3f3e3d2g2d"
DO: LOOP UNTIL INKEY$ <> ""
EXIT DO
END IF
'vuoron vaihto
vuoro = vuoro + 1
IF vuoro > 1 THEN vuoro = 0
mouseshow
mousedown = false
END IF
LOOP
mousehide
CLS
PRINT "BOWMAN by Tarmo Korpela the SQWIIK"
END
'MakeDataImagen tekemä kuvajainen
imgdataukkeli:
DATA 128, 32, 0, 0, 0, 3840, 15, 0, 0, 0, 0, 0, 0, 1807, 3847, 0, 0, 0, 0, 0, 3840, 1799, 1799, 15, 0, 0, 0, 0, 3840, 1799, 1799, 15, 0, 0, 0, 0, 3840, 1799, 1799, 15, 0, 0, 0, 0, 0, 1807, 3847, 0, 0, 0, 0, 0, 0, 3840, 15, 0, 0, 0, 0, 0, 3855, 3855, 3855, 3855, 0, 0, 0, 3840, 1799, 1799, 1799, 1799, 15, 0, 0, 3840, 1799, 1799, 1799, 1799, 15, 0, 0, 3840, 1799, 1799, 1799, 1799, 15, 0, 0, 3840, 1799, 1799, 1799, 1799, 15, 0, 0, 1807, 1799, 1807, 3847, 1799, 3847, 0, 0, 1807, 3847, 1807, 3847, 1807, 3847, 0, 0, 1807, 3847, 1807, 3847, 1807, 3847, 0, 3840, 1799, 3847, 1807, 3847, 1807, 1799, 15, 3840, 1799, 15, 1807, 3847, 3840, 1799, 15, 3840, 1799, 15, 1807, 3847, 3840, 1799, 15, 0, 3855, 0, 1807, 3847, 0, 3855, 0, 0, 0, 3840, 1799, 1799, 15, 0, 0, 0, 0, 3840, 1799, 1799, 15, 0, 0, 0, 0, 1807, 1799, 1799, 3847, 0, 0, 0, 0, 1807, 3847, 1807, 3847, 0, 0, 0, 0, 1807, 3847, 1807, 3847, 0, 0, 0, 3840, 1799, 3847, 1807, 1799, 15, 0, 0, 3840, 1799, 15, 3840, 1799, 15, 0, 0, 1807, 1799, 15, 3840, 1799, 3847, 0, 0, 1807, 1799, 15, 3840, 1799, 3847, 0, 0, 1807, 1799, 15, 3840, 1799, 3847, 0, 0, 1807, 1799, 15, 3840, 1799, 3847, 0, 3840, 1799, 1799, 15, 3840, 1799, 1799, 15, 3840, 3855, 3855, 15, 3840, 3855, 3855, 15, 0
datahiiri: 'konekielinen ohjelmanpätkä hiiren käsittelyyn :)
DATA 55,89,E5,8B,5E,0C,8B,07,50,8B,5E,0A,8B,07,50,8B
DATA 5E,08,8B,0F,8B,5E,06,8B,17,5B,58,1E,07,CD,33,53
DATA 8B,5E,0C,89,07,58,8B,5E,0A,89,07,8B,5E,08,89,0F
DATA 8B,5E,06,89,17,5D,CA,08,00
FUNCTION countanglemov (x AS INTEGER, y AS INTEGER, kx AS INTEGER, ky AS INTEGER, xm AS SINGLE, ym AS SINGLE)
IF x = kx OR y = ky THEN
IF x = kx THEN
IF y < ky THEN ym = 1 ELSE ym = -1
ELSE
IF x < kx THEN xm = 1 ELSE xm = -1
END IF
ELSEIF ABS(x - kx) <= ABS(y - ky) THEN 'x:n muutos pienempi - xm alle 1
xm = (kx - x) / ABS(ky - y)
IF ky - y < 0 THEN ym = -1 ELSE ym = 1
ELSE
ym = (ky - y) / ABS(kx - x)
IF kx - x < 0 THEN xm = -1 ELSE xm = 1
END IF 'nyt on xm ja ym - menee suoraan kohteeseen viivana ilman mutkia
IF ABS(x - kx) > ABS(y - ky) THEN countanglemov = ABS(x - kx) ELSE countanglemov = ABS(y - ky)
END FUNCTION
SUB delay (sec AS INTEGER)
DIM a AS LONG, b AS INTEGER
FOR b = 0 TO sec
FOR a = 0 TO sadasosasekunti
NEXT a, b
END SUB
SUB dotline (x1 AS INTEGER, y1 AS INTEGER, x2 AS INTEGER, y2 AS INTEGER, col1 AS INTEGER, col2 AS INTEGER)
DIM xm AS SINGLE, ym AS SINGLE, ll AS INTEGER, a AS INTEGER
ll = countanglemov(x1, y1, x2, y2, xm, ym)
FOR a = 0 TO ll
IF POINT(INT(x1 + xm * a), INT(y1 + ym * a)) = col1 THEN PSET (INT(x1 + xm * a), INT(y1 + ym * a)), col2
NEXT a
END SUB
FUNCTION flyarrow (x1 AS INTEGER, y1 AS INTEGER, x2 AS INTEGER, y2 AS INTEGER)
DIM xm AS SINGLE, ym AS SINGLE, a AS INTEGER, xx AS SINGLE, yy AS SINGLE
DIM voima AS SINGLE, b AS INTEGER
voima = countanglemov(x1, y1, x2, y2, xm, ym)
IF voima > 100 THEN voima = 100
voima = voima / 100 'prosenttiosuus maximista
xm = voima * xm: ym = voima * ym
xx = x1: yy = y1
DO
dotline INT(xx), INT(yy), xx - arrowlen * xm, yy - arrowlen * ym, 2, 0
xx = xx + xm
yy = yy + ym
IF ym < 1 THEN
ym = ym + gravity
END IF
dotline INT(xx), INT(yy), xx - arrowlen * xm, yy - arrowlen * ym, 0, 2
IF POINT(xx + xm, yy + ym) <> 0 AND POINT(xx + xm, yy + ym) <> 2 AND POINT(xx + xm, yy + ym) <> 10 AND POINT(xx + xm, yy + ym) <> 4 THEN EXIT DO
delay 40
LOOP
dotline INT(xx), INT(yy), xx - arrowlen * xm, yy - arrowlen * ym, 2, 10
b = ishit(xx + xm, yy + ym)
IF b > 0 THEN 'osuttiin... piirretään VERTA!
FOR a = 0 TO 10
LINE (INT(xx), INT(yy))-(INT(xx) + INT(RND * 5) - 2, INT(yy) + INT(RND * 5) - 2), 4
NEXT a
IF ukot(b - 1).kesto <= 0 THEN
flyarrow = true: EXIT FUNCTION
END IF
END IF
flyarrow = false
END FUNCTION
FUNCTION ishit (x AS INTEGER, y AS INTEGER)
DIM a AS INTEGER
FOR a = 0 TO 1
IF x >= ukot(a).x AND x < ukot(a).x + 16 AND y >= ukot(a).y AND y < ukot(a).y + 32 THEN
ukot(a).kesto = ukot(a).kesto - 1
ishit = a + 1: EXIT FUNCTION
END IF
NEXT a
ishit = 0
END FUNCTION
SUB MakeDataImage (kuva() AS INTEGER, filu AS STRING, nimi AS STRING)
'Kirjoittaa tiedoston loppuun data-lausekkeet, joista voidaan lukea
'pakattu kuva taas muistiin.
DIM f AS INTEGER, a AS INTEGER
f = FREEFILE
OPEN filu FOR APPEND AS #f
PRINT #f, nimi + ":"
PRINT #f, "DATA ";
FOR a = 0 TO UBOUND(kuva) - 1
PRINT #f, STR$(kuva(a)) + ",";
NEXT a
PRINT #f, STR$(kuva(UBOUND(kuva)))
CLOSE #f
'Nyt kuva on tallessa bas-tiedostossa
END SUB
SUB makekentta
DIM y AS INTEGER
' Tekee nopeasti kentän
ukot(0).x = INT(RND * 40)
ukot(0).y = INT(RND * 150) + 20
ukot(0).kesto = maxkesto
ukot(1).x = 290 - INT(RND * 40)
ukot(1).y = INT(RND * 150) + 20
ukot(1).kesto = maxkesto
LINE (ukot(0).x, ukot(0).y + 32)-(ukot(0).x + 16, ukot(0).y + 35), 6, BF
LINE (ukot(1).x, ukot(1).y + 32)-(ukot(1).x + 16, ukot(1).y + 35), 6, BF
'piirretään ukkelit
PUT (ukot(0).x, ukot(0).y), ukkeli
PUT (ukot(1).x, ukot(1).y), ukkeli
'ja este kentälle :)
y = (ukot(0).y + ukot(1).y) / 2
LINE (150, y)-(160, y + 80), 6, BF
END SUB
SUB MouseDriver (AX%, BX%, CX%, DX%)
DEF SEG = VARSEG(mouse$)
mouse% = SADD(mouse$)
CALL Absolute(AX%, BX%, CX%, DX%, mouse%)
END SUB
SUB mousehide
AX% = 2
MouseDriver AX%, 0, 0, 0
END SUB
FUNCTION MouseInit
AX% = 0
MouseDriver AX%, 0, 0, 0
MouseInit = AX%
END FUNCTION
SUB MousePut (x%, y%)
AX% = 4
CX% = x%
DX% = y%
MouseDriver AX%, 0, CX%, DX%
END SUB
SUB mouseshow
AX% = 1
MouseDriver AX%, 0, 0, 0
END SUB
SUB mousestatus
AX% = 3
MouseDriver AX%, BX%, CX%, DX%
mouse.button = BX%
mouse.x = INT(CX% / 2)
mouse.y = DX%
END SUB'Tällä piirsin ukkelin kuvan: DIM ukkeli(258) AS INTEGER 'ukkelin koko = 16x32+2 SCREEN 13 'piirretään ukko DRAW "bm8,0c15lg2d2f2dl3gd3gd2gd2freueu2ed6gdgd2gdgd3gdr5u6e" + "u2rd2fd6r5uhu3huhu2huhu6fd2fdfreu2hu2hu3hl3bdp7,15buc15ue2u2h2bdp7,15" GET (0, 0)-(15, 31), ukkeli 'Eli tuo bowman.bas oli tuo pelin tiedosto :) MakeDataImage ukkeli(), "bowman.bas", "dataukkeli"
saisko täst exe:n
Absolute-komento ei toimi exeksi kääntävissä qbeissa samalla tavalla kuin vanhassa qb:ssa, joten tuollaisenaan se ei käänny. Hiiriohjauksen voisi tietenkin ottaa toisellakin tapaa.
DIM ukkeli(258) AS INTEGER
Herjaa: Array already dimensioned
Oletko vahingossa määritellyt tuon jossain useamman kerran?
Sinänsä koodi ja idea vaikuttaa mielenkiintoiselta. Olisi kiva päästä kokeilemaan.
Älä pura alempaa koodinpätkää samaan tiedostoon (se on erillinen hommeli)
minä näin parhaaksi kommentoida sen:
"DIM ukkeli(258) AS INTEGER"...
Eh? OK tekstin jälkeen PIIPIIPIIPIIPII... koko kone tilttaa. Taitaa sonkata tossa jossakin hiiren määrityksessä...? :(
Kuten sanottu, ohjelma toimii vain ja ainoastaan vanhalla QB:lla, ei siis 4.5:lla tai 7.1:llä.
Hyviä ootte värkkää :P
tyhmä kysymys.. toimisko tuo delay jossai omassa jutussani jos gopsaisin sen delay sub "osion" :S
Toimiihan toki, kunhan kopioit myös sen kohdan missä lasketaan tuo sadasosasekunti...
Aihe on jo aika vanha, joten et voi enää vastata siihen.