DECLARE SUB ENDPG ()
' List 2 : Main Program ---- <<<  Won-Key GAME  for QBasic  >>>
DECLARE SUB MATU (w&)
COMMON SHARED wa AS INTEGER
SCREEN 7, 0, 5, 0: DEFINT C-F, L-M, W
DIM c%(179, 20, 1), g%(375): RANDOMIZE VAL(RIGHT$(TIME$, 2))
DIM l0(34), l1(34, 2), fx(30, 2), fy(30, 2), fa(30, 2), dx(10, 2), jx(20, 2)
DEF FNH (a) = (a = 1) - (a = 0): DEF FNL$ (a) = LTRIM$(STR$(a))
DEF FNC (a, B) = -(POINT(a - 4, B) = 14) - (POINT(a + 4, B) = 14)
t$ = TIME$: WHILE t$ = TIME$: WEND
t$ = TIME$: WHILE t$ = TIME$: w& = w& + 1: WEND
wa = INT((w& \ 120) / 100) * 100
FOR i = 0 TO 12: READ a, B: PALETTE a, B: NEXT
DATA 1,0, 2,15, 3,12, 4,8, 5,2, 6,10, 8,1, 9,4, 10,0, 11,14, 14,2, 12,6, 15,4
'-------------- Make Gate & Load Data
CIRCLE (23, 30), 30, 9, , , 1.3: PAINT (23, 30), 1, 9
GET (0, 0)-(46, 30), g%
DEF SEG = VARSEG(c%(0, 0, 0))
BLOAD "saru.dat", VARPTR(c%(0, 0, 0))
'-------------- Shoki-Settei
a = 36: k(0) = a * 3.14 / 180: k(1) = (180 - a) * 3.14 / 180
nk(0) = 1.52 - k(0): nk(1) = 1.62 - k(1): B(0) = .32: B(1) = .3
FOR i = 0 TO 33: l0(i) = i * 100: NEXT: mst = 2
FOR i = 0 TO 1: nvx(i) = COS(k(i)) * 2: nvy(i) = -SIN(k(i)) * 1.6: NEXT
jpy(0) = -14: jpy(1) = -26: M$ = "  Miss!!  Game Over!"
'-------------- Make Title
PAINT (0, 0), 1: LINE (0, 17)-(319, 182), 0, BF
COLOR 6: LOCATE 9, 15: PRINT "Won-Key GAME"
PUT (144, 92), c%(0, 7, 0), PSET
FOR i = 0 TO 1: FOR j = 0 TO 1: p = -(j - i = 0) + (j XOR i) * 4
PUT (j * 283 + 2, i * 140 + 20 + ((i > j) + (i < j)) * 2), c%(0, p, j), PSET
NEXT j, i
'-------------- Title
TITLE:
PALETTE 0, 6: PCOPY 5, 0: SCREEN , , 5, 5: ef = 0: gfk = 0
GOSUB KMATI: st = 0: lf = 4: ti = 1500: RESTORE DS: PLAY "MBMNl64"
'-------------- Game Start
GSTART1: fl = 0: lg = 0: ti = ti + 2000: GOSUB RDATA
GSTART2:
sx = gx(lg, fl) - 196: sx = sx - (sx < 1500) * 72: sy = 161: sp = 1
mu = -(sx > 1500): joutai = 1: tt = 0: buf = 0: fuf = 0: chaf = 1
v = 0: vx = 0: vy = 0: io = 1: cx = 160: cy = sy: cr = 0: ef = 0
FOR i = 0 TO 2: FOR j = 0 TO dk(i): dx(j, i) = d1(j, i): dcn(j, i) = d2(j, i): NEXT j, i
SCREEN , , 0, 0: LINE (0, 17)-(319, 183), 1, BF
COLOR 2: LOCATE 13, 16: PRINT "Stage "; FNL$(st + 1); "-"; FNL$(fl + 1)
MATU 70: SCREEN , , 1, 0: GOSUB GAMEN: GOSUB KAKU: GOSUB FADE '<--
'-------------- Main
MAIN:
 WHILE ef = 0: n = 0
   WHILE n < 2 AND chaf
     IF ABS(160 - gx(n, fl) + sx) < 28 THEN
       cx = gx(n, fl) - sx: cy = sy: GOSUB GAMEN: GOSUB FADE: fl = fl - FNH(n)
       fuf = 0: IF fl < 0 THEN ef = 2 - (st = mst): GOTO GOVER
       sx = gx(1 - n, fl) - 196: sx = sx - (sx < 1500) * 72: GOSUB GAMEN
       lg = 1 - n: mu = -(sx > 1500): GOSUB KAKU: GOSUB FADE: n = n + 1
     END IF: n = n + 1
   WEND
   tt = tt + (tt > 0): ON -(tt = 0) GOSUB KI
   SCREEN , , 0, 0
   ON (joutai + 1) * (1 - chaf) GOSUB FURIKO, TOBU, NAWA, JUMP
   SCREEN , , 1, 0
   GOSUB GAMEN: GOSUB KAKU: GOSUB DOG
   ON fuf GOSUB FTOBU: ti = ti - 1
   ef = ef - ((joutai = 1 AND sy > 175 OR ti = 0) AND ef = 0)
   GOSUB HYOUJI

   wt = wt + (wt > 0)
   IF wt = 0 THEN
     i = INP(&H60)
     wt = 2: wa = wa + ((i = 79 AND wa > 100) - (i = 80)) * 100
   END IF
   LINE (0, 193)-(wa \ 4 - 25, 194), 11, B
   LOCATE 24, 1: COLOR 2: PRINT "Game Speed:";
  
   PCOPY 1, 0: LINE (0, 17)-(319, 182), 0, BF
                                        
   MATU 2
 WEND
'-------------- Stage Clear &   Game Over
GOVER:
 SCREEN , , 0, 0
 SELECT CASE ef
   CASE 1: ON -(sy > 175) GOSUB DOBON: lf = lf - 1: of = -(lf = 0 OR ti = 0)
           COLOR 11 - of * 10: LOCATE 12, 16: PRINT MID$(M$, of * 10 + 1, 10)
   CASE 2: COLOR 2: LOCATE 13, 14: PRINT "Stage"; st + 1; "Clear!": st = st + 1
   CASE 3: COLOR 2: LOCATE 13, 13: PRINT "All Stage Clear!!": SCREEN , , 1, 0
           PLAY "o5c>e<e": MATU 90: nl = 120: nx = 160: ny = 20: v = 0
           PUT (283 - (gfk > 50) * 4, 162), c%(0, 4, -(gfk < 95))
           FOR i = 0 TO 1: a = i * 298: LINE (a, 0)-(a + 40, 199), 12, BF
           NEXT: p = -(gfk < 51) - (gfk < 95) - (gfk > 94) * 3: GOSUB SARU
           PSET (-1, RND * 30 + 20): PALETTE 0, 9: WHILE INKEY$ <> "": WEND
           FOR i = 0 TO 90: LINE -(i * 40, RND * 30 + 20), 14: NEXT: cy = 165
           PAINT (0, 0), 6, 14: LINE (0, 184)-(319, 199), 6, BF: PCOPY 1, 3
           GOSUB FADE: PCOPY 3, 1: cc = 1: nk = k(0) + (p = 2) * .5 - (p = 3) * .3
           WHILE INKEY$ <> CHR$(13)
             GOSUB FURIKO: LINE (nx, ny)-(sx - COS(kk) * 16, sy), 6
             PUT (sx - 16, sy - 4), c%(0, 10, mu), AND
             PUT (sx - 16, sy - 4), c%(0, 0, mu): MATU 4 '<--
             COLOR 2 - (gfk = 100) * RND * 13: LOCATE 13, 13
             PRINT "Get Fruits : "; FNL$(gfk): PCOPY 1, 0: PCOPY 3, 1
           WEND
 END SELECT
 ON -(ef < 3) GOSUB KMATI: ON -(ef = 2) GOTO GSTART1
 IF ef = 1 THEN LINE (0, 0)-(319, 16), 1, BF: LINE (0, 183)-(319, 199), 10, BF
 PCOPY 0, 1: io = 0: cx = 160: cy = 165: cr = 198: GOSUB FADE
 gfk = gfk + (gfk > 0): ON of + ef GOTO GSTART2
 MATU 60: GOTO TITLE
SARU:
 FOR i = 0 TO 7: PUT (32 + i * 31, 164), c%(0, p + 10, 0), AND
                 PUT (32 + i * 31, 164), c%(0, p, -(p = 1) * RND): NEXT: RETURN
'-------------- Key Check
KI:
 WHILE INKEY$ <> "": WEND: i = INP(&H60): mut = mut + (mut > 0)
 IF i = 57 AND chaf = 0 THEN joutai = (joutai + 1) MOD 3: tt = 6
 IF i = 42 AND joutai > 0 AND mut = 0 THEN mu = 1 - mu: mut = 4
 jp = jp - (i = 57 AND chaf = 1)
 IF i <> 57 AND jp > 0 OR jp > 2 THEN chaf = 0: joutai = 3: tt = 2 - (jp > 2) * 5
 IF i = 1 THEN ENDPG
 RETURN
'-------------- FURIKO
FURIKO:
 IF cc > 0 THEN
   v = v - 9.8 * SIN(nk) * .5: nk = nk + v * .5 / nl
   a = sx: kk = nk + 1.57
   sx = nx + COS(kk) * nl: sy = ny + SIN(kk) * nl * .8
   mu = -(v > 1): M = FNH(mu)
   IF POINT(160 + M * 16, yy) > 13 THEN sx = a: buf = 1: joutai = 1: mu = 1 - mu
   IF POINT(160, sy + 11) = 14 THEN sy = 161: ff = 1: buf = 0: chaf = 1: joutai = 1: sp = 1
 ELSE joutai = 1: ff = 1: vy = vy * .7: mu = 1 - mu
 END IF
 RETURN
'-------------- Fly
TOBU:
 IF ff = 0 THEN ff = 1: vx = -FNH(buf) * v * B(buf): vy = v * COS(kk) * 1.1
 sx = sx + vx
 sy = sy + vy * .5: vy = vy + 1.8
 IF jf AND vy < 0 AND POINT(160 + SGN(vx) * 17, sy - 11) = 15 THEN vy = -vy * .8
 IF mcf = 0 AND POINT(160 + SGN(vx) * 18, sy - 9) = 15 THEN vx = -vx * .6: mu = 1 - mu: mcf = 1
 IF vy > 0 AND sy > 154 AND FNC(160 + vx, 174) > 0 THEN sy = 161: chaf = 1: vx = 0: vy = 0: jf = 0: mcf = 0: buf = 0
 buf = -buf * (vy < 0)
 sp = 1 - ((fuf OR buf) = 1 AND chaf = 0)
 RETURN
'-------------- NAWA
NAWA:
 gnx = 160 + nvx(mu) * 4: ny = sy + nvy(mu) * 4: cc = 0
 WHILE cc >= 0 AND cc < 15
   gnx = gnx + nvx(mu): ny = ny + nvy(mu)
   cc = POINT(gnx, ny)
 WEND
 nl = INT(SQR((gnx - 160) ^ 2 + (ny - sy) ^ 2))
 nk = nk(mu): nx = sx + gnx - 160
 v = 0: joutai = 0: jf = 0: ff = 0: mcf = 0: buf = 0
 kk = nk + 1.57: sp = 0: tt = 6
 RETURN
'--------------
JUMP:
 jf = 1: vx = FNH(mu) * (3 - (jp > 2) * 2): vy = jpy(1 + (jp < 3))
 ff = 1: joutai = 1: jp = 0: RETURN
'--------------
FTOBU:
 fx = fx + fvx: fy = fy + fvy: fvy = fvy + 2: x = fx - sx
 IF x > 0 AND x < 287 AND fy < 166 THEN PUT (x, fy), c%(0, 7, -(fvx < 0)), OR ELSE fuf = 0
 RETURN
'-------------- NAWA & SARU draw
KAKU:
 IF joutai = 0 THEN LINE (160 + nx - sx, ny)-(160 - COS(kk) * 16, sy - SIN(kk) * 13), 6
 IF sy < 175 THEN PUT (144, sy - 11), c%(0, sp + 10, mu), AND: PUT (144, sy - 11), c%(0, sp, mu)
 IF sy > 166 THEN yy = 182 ELSE yy = sy + 2
 RETURN
'-------------- Dogs' Actions
DOG:
 FOR i = 0 TO dk(fl): dt(i) = dt(i) + (dt(i) > 0)
   IF dx(i, fl) - sx > -100 AND dx(i, fl) - sx < 420 AND dt(i) = 0 THEN
     IF dc(i) = 0 THEN
       dpc(i) = 1: dxv(i) = ((RND > .8) - (RND < .2)) * 4
       IF sy > 130 THEN dxv(i) = FNH(-(dx(i, fl) - sx >= 160)) * 8
       IF dxv(i) THEN dmu(i) = -(dxv(i) < 0)
       dc(i) = INT(RND * 8) + i - (ABS(dxv(i)) = 8) * 6
     END IF
     dc(i) = dc(i) + (dc(i) > 0): d = dx(i, fl) + dxv(i): dc = dcn(i, fl)
     IF dxv(i) AND d > jx(dc, fl) - 4 AND d < jx(dc + 1, fl) + 4 THEN
       dx(i, fl) = d: dpc(i) = dpc(i) + 1 AND (3 + (ABS(dxv(i)) = 8) * 2)
       ELSE dpc(i) = 1
     END IF
     dp(i) = 4 - (dpc(i) = 0): M = FNH(dmu(i))
     IF chaf AND ABS(160 - dx(i, fl) - M * 16 + sx) < 11 THEN
       gfk = gfk - 1: fuf = -(gfk > -1): chaf = 0
       vx = M * 4: vy = -24: fx = sx + 160 - SGN(vx) * 16: fy = sy - 11
       fvx = -vx * 1.5: fvy = -16: jf = 1
       dc(i) = 0: dp(i) = 4: dt(i) = 30: tt = 6: jp = 0: PLAY "o3dfec"
       ef = ef - (gfk < 0 AND ef = 0): gfk = -gfk * (gfk > -1)
     END IF             '--- butukaru
   END IF

   IF joutai AND vy > 0 AND ABS(160 - dx(i, fl) + sx) < 24 AND ABS(145 - sy) < 7 THEN
     vy = -22: jf = 1: dp(i) = 6: dt(i) = 25: IF ABS(vx) < 3 THEN vx = FNH(mu) * 4
   END IF               '--- fumu
   IF dx(i, fl) - sx > 16 AND dx(i, fl) - sx < 303 THEN
     PUT (dx(i, fl) - sx - 16, 148), c%(0, dp(i) + 10, dmu(i)), AND
     PUT (dx(i, fl) - sx - 16, 148), c%(0, dp(i), dmu(i))
   END IF
 NEXT: RETURN
'-------------- Draw Screen & Fruits Check
GAMEN:
 FOR i = 0 TO 1  '------------------------------- Gate
   IF gx(i, fl) - sx > 23 AND gx(i, fl) - sx < 296 THEN
     PUT (gx(i, fl) - sx - 23, 140), g%
     IF i + fl = 0 THEN COLOR 2: LOCATE 17, (gx(i, fl) - sx) \ 8: PRINT "Exit"
   END IF
 NEXT
 LINE (0, 176)-(319, 185), 8, BF  '------------- Jimen
 FOR i = 0 TO jk(fl) STEP 2
   IF jx(i, fl) - sx < 319 AND jx(i + 1, fl) - sx > 0 THEN
     LINE (jx(i, fl) - sx, 170)-(jx(i + 1, fl) - sx, 199), 14, BF
     CIRCLE (jx(i, fl) - sx, 183), 16, 14: PAINT STEP(-1, 0), 14
     CIRCLE (jx(i + 1, fl) - sx, 183), 16, 14: PAINT STEP(1, 0), 14
   END IF
 NEXT
 ii = -(sx \ 100) * (sx > 0)  '---------------- Tenjou
 FOR i = ii TO ii + 4
   LINE (l0(i) - sx, l1(i, fl))-(l0(i + 1) - sx, l1(i + 1, fl)), 1
 NEXT: PAINT (0, 0), 15, 1
 fpc = fpc + 1 AND 15  '----------------------- Fruits
 FOR i = 0 TO fk(fl)
   IF fa(i, fl) AND fx(i, fl) - sx > 16 AND fx(i, fl) - sx < 303 THEN
     PUT (fx(i, fl) - sx - 16, fy(i, fl) - fp * 2), c%(0, 7, -(fpc > 6)), OR
     IF ABS(160 - fx(i, fl) + sx) < 18 AND ABS(fy(i, fl) + 11 - sy) < 20 THEN
       fa(i, fl) = 0: gfk = gfk + 1: PLAY "o5c>e<e"
     END IF
   END IF
 NEXT
 LINE (0, 0)-(319, 16), 10, BF
 LINE (0, 183)-(319, 199), 10, BF

 RETURN
'--------------
DOBON:
 FOR i = 0 TO 1
   PUT (144, 154), c%(0, 8 + i, 0): MATU 15 '<--
   PUT (144, 154), c%(0, 8 + i, 0)
 NEXT: RETURN
'-------------- Fade IN/OUT
FADE:
 SCREEN , , 2, 0
 WHILE cr > -1 AND cr < 204
   PCOPY 1, 2:
   CIRCLE (cx, cy), cr, 10: PAINT (0, 17), 10: PAINT (319, 17), 10
   PCOPY 2, 0: cr = cr - FNH(io) * (9 + (ef > 1) * 3)
 WEND: io = 1 - io: cx = 160: cr = 203 - io * 203
 SCREEN , , 1, 0: CLS
 RETURN
'--------------
HYOUJI:
 COLOR 2 - (ti < 200) * 9 + (ti < 50) * 8
 LOCATE 1 - (ef = 2), 17: PRINT "Time:"; RIGHT$("0000" + LTRIM$(STR$(ti)), 4)
 COLOR 2: LOCATE 2, 2: PRINT " Fruits:"; gfk: LOCATE 2, 31: PRINT " Left:"; lf - 1
 RETURN
'--------------
KMATI:
 COLOR 2: LOCATE 18 - (ef > 1) * 6, 14: PRINT "Push Enter Key";
 i = INP(&H60)
 WHILE i <> 28 AND i <> 16
   i = INP(&H60)
   IF i = 1 THEN ENDPG
 WEND

 RETURN
'-------------- Read Stage Data
RDATA:
FOR i = 0 TO 1
  l1(0, i) = 199: l1(1, i) = 40: l1(2, i) = 20: l1(30, i) = 80
  l1(31, i) = 199: l1(32, i) = 199: l1(33, i) = 199: l1(34, i) = 199
  FOR j = 1 TO 30
    READ l1(j, i): l1(j, i) = l1(j, i) * 10 - (l1(j, i) < 1)
  NEXT
  READ jk(i): FOR j = 0 TO jk(i): READ a: jx(j, i) = a * 4: NEXT
  READ fk(i): FOR j = 0 TO fk(i): READ a, B: fx(j, i) = a * 4: fy(j, i) = B * 4: fa(j, i) = 1: NEXT
  READ dk(i): FOR j = 0 TO dk(i): READ d1, d2(j, i): d1(j, i) = d1 * 4: NEXT
  FOR j = 0 TO 1: READ gx(j, i): NEXT
NEXT: RETURN
'-------------- Stage DATA
DS:
'Stage 1-1
DATA 5,2,3,2,3,4,3,5,3,2,3,5,3,5,2,5,2,3,2,3,2,4,4,2,3,2,3,2,3,4
DATA 11 ,6,71 ,88,252 ,299,351 ,401,525 ,601,697 ,715,759
DATA 18 ,37,21 ,46,15 ,56,14 ,64,20 ,68,27 ,105,25 ,145,27 ,220,30 ,275,31 ,275,25
DATA 325,27 ,433,25 ,464,28 ,508,27 ,556,31 ,556,25 ,625,27 ,701,24 ,710,24
DATA 2 ,606,8 ,648,8 ,691,8    ,88 ,2948
'      1-2
DATA 6,3,5,3,2,3,2,3,2,3,2,6,6,3,2,4,2,4,2,5,4,5,3,4,2,4,3,3,3,5
DATA 5 ,48,276 ,415,439 ,623,751
DATA 13 ,27,33 ,52,37 ,56,31 ,60,37 ,124,25 ,250,25 ,377,29
DATA 428,28 ,475,35 ,475,22 ,566,32 ,575,32 ,649,25 ,694,30
DATA 2 ,99,0 ,179,0 ,271,0    ,2940 ,-1000
'Stage 2-1
DATA 5,2,4,2,5,2,6,2,3,6,3,2,4,6,6,5,2,7,2,2,5,2,2,4,2,2,4,2,2,5
DATA 13 ,4,40 ,106,142 ,233,269 ,349,377 ,437,465 ,581,621 ,675,755
DATA 16 ,61,27 ,75,31 ,88,27 ,175,30 ,287,15 ,317,32 ,406,30 ,492,29 ,500,29
DATA 508,29 ,516,29 ,584,37 ,584,31 ,619,31 ,619,37 ,700,20 ,725,20
DATA 1 ,601,10 ,679,12    ,96 ,2972
'      2-2
DATA 10,5,3,2,4,4,6,10,11,11,7,8,2,6,2,4,2,6,4,7,2,4,2,7,2,6,2,3,2,3
DATA 7 ,285,325 ,371,431 ,549,581 ,682,758
DATA 15 ,41,35 ,57,28 ,74,25 ,90,23 ,107,22 ,115,35 ,124,22 ,141,22
DATA 160,24 ,181,31 ,400,30 ,400,18 ,486,31 ,565,31 ,565,25 ,743,20
DATA 2 ,383,2 ,419,2 ,735,6    ,2792 ,-1000
'Stage 3-1
DATA 5,3,5,8,0,9,8,6,4,0,8,7,6,5,3,4,7,9,7,9,6,6,8,7,4,7,8,3,2,4
DATA 9 ,36,68 ,270,350 ,534,541 ,610,642 ,729,770
DATA 13 ,248,28 ,248,22 ,248,16 ,309,37 ,374,22 ,475,30 ,538,37
DATA 538,31 ,538,25 ,538,19 ,626,37 ,699,21 ,709,33 ,719,21
DATA 1 ,274,2 ,346,2
DATA 2996 ,208
'      3-2
DATA 4,2,2,7,6,9,6,9,10,8,7,10,8,7,3,5,2,5,2,6,8,8,6,0,7,8,8,7,2,3
DATA 7 ,53,61 ,366,482 ,603,623 ,726,754
DATA 19 ,45,31 ,49,25 ,53,19 ,53,31 ,57,37 ,57,13 ,57,25 ,61,19
DATA 61,31 ,65,25 ,69,31 ,263,35 ,378,37 ,409,25 ,425,25 ,440,25
DATA 472,37 ,612,20 ,612,32 ,715,31
DATA 2 ,57,0 ,390,2 ,461,2    ,2968 ,-1000

SUB ENDPG

        STOP

'>>>> Press [Alt]+[f] -> [x]

END SUB

DEFSNG C-F, L-M, W
SUB MATU (w&)
  ww& = wa * w&: WHILE ww&: ww& = ww& - 1: t$ = TIME$: WEND
END SUB