Keskustelu: Koodit: QB: Jousiammuntaa

sqwiik [15.05.2004 13:24:34]

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"

sami kauppinen [16.05.2004 06:55:24]

saisko täst exe:n

sqwiik [16.05.2004 10:31:29]

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.

hunajavohveli [16.05.2004 13:22:31]

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.

sqwiik [16.05.2004 13:32:16]

Älä pura alempaa koodinpätkää samaan tiedostoon (se on erillinen hommeli)

Wukkopi [17.05.2004 12:40:13]

minä näin parhaaksi kommentoida sen:

"DIM ukkeli(258) AS INTEGER"...

sooda [23.05.2004 19:26:12]

Eh? OK tekstin jälkeen PIIPIIPIIPIIPII... koko kone tilttaa. Taitaa sonkata tossa jossakin hiiren määrityksessä...? :(

sqwiik [30.05.2004 14:34:34]

Kuten sanottu, ohjelma toimii vain ja ainoastaan vanhalla QB:lla, ei siis 4.5:lla tai 7.1:llä.

crafn [15.06.2005 21:27:14]

Hyviä ootte värkkää :P

Tore [08.11.2005 17:38:30]

tyhmä kysymys.. toimisko tuo delay jossai omassa jutussani jos gopsaisin sen delay sub "osion" :S

sqwiik [04.12.2005 17:51:12]

Toimiihan toki, kunhan kopioit myös sen kohdan missä lasketaan tuo sadasosasekunti...

Sivun alkuun

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Kirjautuminen

Haku

Tehtävät

Kilpailu