-
Notifications
You must be signed in to change notification settings - Fork 2
/
COSMIC2.BAS
1407 lines (1205 loc) · 36.9 KB
/
COSMIC2.BAS
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
DECLARE SUB VocVolume (Right%, Left%, Getvol%)
DECLARE SUB DMAState (StopGo%)
DECLARE SUB Titres ()
DECLARE SUB FMVolume (Right%, Left%, Getvol%)
DECLARE SUB WaitKey ()
DECLARE SUB RenderStars (X%, Y%, DeltaStars%, Speed%)
DECLARE SUB MakeExplosion (X%, Y%, Xp%, Yp%, DeltaStars%)
DECLARE SUB GoSound (SEvent%, PlayingSound%, StartedSB%)
DECLARE SUB StopMIDI ()
DECLARE SUB KeySupport (INK$, X%, Y%, Side%, ChangedShip%, StGX%, StGY%, GameOver%)
DECLARE SUB ReadShipHands (Hnds%())
DECLARE SUB RenderShip (X%, Y%, Side%, Pl%, k%, Hnds%())
DECLARE FUNCTION CheckIntersection% (X1a%, Y1a%, X2a%, Y2a%, X1b%, Y1b%, X2b%, Y2b%)
DECLARE SUB ReadSprite (Sprite%(), Number%, i%)
DECLARE SUB MyPCXOPEN (Page%, FileName$)
DECLARE SUB ClearKeys ()
DECLARE SUB WaitVSync ()
DECLARE SUB InitAndDetect ()
DECLARE FUNCTION GetKey$ ()
DECLARE SUB MatchPalette (PAL$, NUMCOL%)
DECLARE FUNCTION CheckIn% (Xc%, Yc%, X1%, Y1%, X2%, Y2%)
DECLARE SUB DMAPlay (Segment&, Offset&, Length&, Freq&)
DECLARE FUNCTION DSPVersion! ()
DECLARE SUB GetBLASTER (DMA%, BasePort%, IRQ%)
DECLARE SUB MasterVolume (Right%, Left%, Getvol%)
DECLARE FUNCTION ReadDSP% ()
DECLARE FUNCTION ResetDsp% ()
DECLARE SUB SpeakerState (OnOff%)
DECLARE FUNCTION SpeakerStatus% ()
DECLARE SUB WriteDSP (byte%)
DECLARE SUB PlaySB (NumSound%, PlayingSound%, StartedSB%)
DECLARE SUB LoadAndPlayMIDI (FileName$, MIDISegment%, MIDIOffset%)
DECLARE SUB WriteToDSP (v%)
DECLARE FUNCTION GetBlasterAddr% ()
DECLARE FUNCTION BytesRequired& (FileName$)
DECLARE FUNCTION SBReset% ()
''$INCLUDE: 'SVGABC.BI'
''$INCLUDE: 'MY_SVGA.BI'
'$DYNAMIC
COMMON SHARED BlasterAddr%, DMA%, repeats%, PlayingSound%
COMMON SHARED Path$, PathWav$, PathG$
COMMON SHARED BasePort%, LenPort%, Channel%, MaxNumStars%, MouseON%
'OPTION BASE 1
DEFINT A-Z
RANDOMIZE TIMER
NIL = SBReset
Path$ = "C:\GAMES\COSMIC2\" 'MAIN-¯ãâì
Pat$ = Path$ + "MIDI\" 'MIDI-¯ãâì
PathWav$ = Path$ + "FX\" 'SBFX-¯ãâì
PathG$ = Path$ + "GFX\" 'GRAF-¯ãâì
MouseON = 0 '¢ª«/¢ëª« ã¯à ¢«¥¨¥ ¬ëèìî
InitAndDetect
MyPCXOPEN 0, "COSM_ADV" '‡ £à㦠¥¬ ª à⨪ã á® á¯à ©â ¬¨
'DRWSTRING 1, 15, 8, "By ACA Company, Ryabchenko A.M. Inc.", 500, 550
'DRWSTRING 1, 15, 8, "CALL 590-20-04", 500, 570
SLEEP
NIL = RES640
MyPCXOPEN 1, "KORABLES" '‡ £à㦠¥¬ ª à⨪ã á® á¯à ©â ¬¨
NumfMIDI$ = LTRIM$(STR$(CINT(RND * 16 + 1)))
IF RND > .7 THEN
IF NumfMIDI$ <= "10" THEN NumfMIDI$ = LTRIM$(STR$(VAL(NumfMIDI$) + 5))
END IF
FileMIDI$ = "MUSIC" + NumfMIDI$ + ".MID"
DIM MIDI%(BytesRequired&(Pat$ + FileMIDI$) \ 2)
DIM SHARED Hnds(9, 50), HandTemp(50)
DIM SHARED StartX(10), StartY(10), StepX!(10), DeltaSizY(10), Forms(10), CorrX!(10)
DIM Sprite(4000), Sprite1(4000), Sprite2(4000)
DIM SHARED StarColors(50), StarX(50), StarY(50), StarSpeed(50), StarC(50)
DIM SHARED StarDeltaX!(50)
DIM WavBuffer(1 TO 1) AS STRING * 32767 'Make a 32k buffer for file.
DIM SHARED MIDI.PLAYTIME AS SINGLE
DIM SHARED MIDI.ERROR AS INTEGER
MIDI.PLAYTIME = 0
MIDI.ERROR = 0
GOSUB SetArraysOfData
k = 1
GOSUB SetSB
ReadShipHands Hnds()
StGX = 5 '\ ®ª § ⥫¨ ᪮à®áâ¨
StGY = 4 '/ ¤¢¨¦¥¨ï ª®à ¡«ï ¯® íªà ã
Pl = 4 '®«®¦¥¨¥ ª®à ¡«ï (®¬¥à ª ¤à ),
X = 320: Y = 400 '¥£® ª®®à¤¨ âë
FactP = 0 'F ªâ ¯à¨áãâáâ¢¨ï ¯à¥¯ïâá⢨ï
PozT! = 1 '®¬¥à ª ¤à ¯à¥¯ïâá⢨ï
Tip = 4 '’¨¯ ¯à¥¯ïâá⢨ï
ChangedShip = 1 '” ªâ ¯¥à¥¬¥é¥¨ï ª®à ¡«ï
Speed = 6 '‘ª®à®áâì ª®à ¡«ï
Pzs = 1 '1 <-> -1
FutureFactP = 1 '।᪠§ ¨¥ á⮫ª®¢¥¨ï
Freq& = 14000 '— áâ®â §¢ãª®¢ëå íä䥪⮢
LoadAndPlayMIDI Pat$ + FileMIDI$, VARSEG(MIDI%(0)), VARPTR(MIDI%(0))
'IF MouseON = 1 THEN MOUSELOCSET X, Y
StartTIME& = TIMER
DO
INK$ = GetKey$
CALL KeySupport(INK$, X%, Y%, Side%, ChangedShip%, StGX%, StGY%, GameOver%)
IF PlayingSound = 1 THEN
IF DMADone OR StartedSB = 1 THEN
REDIM WavBuffer(1 TO 1) AS STRING * 32767 'Make a 32k buffer for file.
GET #7, 44 + (32767 * CurrentPlay!), WavBuffer(1)'Get 32k from file (skip header on WAV)
CurrentPlay! = CurrentPlay! + 1
Length& = LOF(7) - 44
IF Length& > 32767 THEN Length& = 32767 'Adjust length if needed to 32k
DMAPlay VARSEG(WavBuffer(1)), VARPTR(WavBuffer(1)), Length&, Freq&
IF EOF(7) THEN PlayingSound = 0: CLOSE #7: CurrentPlay! = 0
StartedSB = 0
END IF
END IF
IF FactTremble = 1 THEN '’àïáãçª
OX = X: OY = Y
Y = CINT(Y + RND * 4 - 2.5)
X = CINT(X + RND * 4 - 2)
IF Tip = 3 OR Tip = 4 THEN X = X + SGN(Xp - X) * 2
IF X > OX THEN Side = Side + 2
IF X < OX THEN Side = Side - 2
ChangedShip = 1
END IF
X1a = Xp
Y1a = Yp
X2a = Xp + StepX!(Tip)
Y2a = Yp + StepX!(Tip) + DeltaSizY(Tip)
X1b = X
Y1b = Y
X2b = X + 55
Y2b = Y + 55
IntSec = CheckIntersection(X1a, Y1a, X2a, Y2a, X1b, Y1b, X2b, Y2b)
IF ChangedShip = 1 OR IntSec = 1 THEN
IF IntSec = 0 THEN
RenderShip X, Y, Side, Pl, k, Hnds()
ELSE
NIL = PAGEACTIVE(1)
RenderShip 580, 1, Side, Pl, k, Hnds()
'BLKGET 580, 1, 580 + 55, 1 + 55, Sprite(1)
NIL = PAGEACTIVE(0)
'SPRITEPUT 1, 0, X, Y, Sprite(1)
END IF
'IF FactTremble = 1 THEN DRWFILLBOX 1, 0, X - 3, Y, X, Y + 55
END IF
IF FactP = 0 AND FactOvr = 0 THEN 'ï¬ ¯à¥¯ïâá⢨ï - é ᤥ« ¥¬!
Xp = X + RND * 100 - 50
Yp = -80
FactP = 1
DO
Tip = RND * 7 + 3
IF Tip = 6 AND k = 5 THEN Tip = 5
IF Tip = 9 AND FactTremble = 1 THEN Tip = 5
IF Tip = 7 AND k <> 2 AND FactTremble <> 1 THEN Tip = 5
IF Tip <> 5 AND Tip < 10 THEN EXIT DO
LOOP
IF RND > .7 THEN Tip = 8
IF RND > .5 THEN Tip = 3 + RND * 1
ELSE
OXp = Xp: OYp = Yp '‡ ¯®¬¨¬ áâ àë¥ ª®®à¤¨ âë
IF Pzs = 1 THEN
ReadSprite Sprite1(), INT(PozT!), Tip
ELSE
ReadSprite Sprite2(), INT(PozT!), Tip
END IF
PozT! = PozT! + .16 '‘¬¥ ª ¤à
IF PozT! > Forms(Tip) THEN PozT! = 1
Yp = Yp + Speed '९ïâá⢨¥ ¯ ¤ ¥â ¢¨§
IF Yp > 480 THEN FactP = 0 '९ïâá⢨¥ ¯à®«¥â¥«® ¢¥áì íªà
IF IntSec = 0 THEN '…᫨ ¯¥à¥á¥ç¥¨© á ª®à ¡«¥¬ ¥â
'DRWFILLBOX 1, 0, OXp, OYp - Speed, OXp + StepX!(Tip), OYp + Speed
IF Pzs = 1 THEN
'SPRITEPUT 1, 1, Xp, Yp, Sprite2(1)
'SPRITEPUT 1, 0, Xp, Yp, Sprite1(1)
ELSE
'SPRITEPUT 1, 1, Xp, Yp, Sprite1(1)
'SPRITEPUT 1, 0, Xp, Yp, Sprite2(1)
END IF
ELSE
'DRWFILLBOX 1, 0, OXp, OYp - Speed, OXp + StepX!(Tip), OYp + Speed
IF Pzs = 1 THEN
'SPRITEPUT 2, 0, OXp, OYp, Sprite2(1)
Coll = SPRITECOLLDETECT(0, X, Y, Xp, Yp, Sprite(1), Sprite1(1))
IF FutureFactP <> 0 THEN
'SPRITEPUT 1, 0, Xp, Yp, Sprite1(1)
ELSE
'DRWFILLBOX 1, 0, OXp, OYp - StepX!(Tip) - Speed, OXp + StepX!(Tip), OYp + Speed + StepX!(Tip)
RenderShip X, Y, Side, Pl, k, Hnds()
END IF
IF Coll = 2 THEN '…᫨ ¯à®¨§®è«® á⮫ª®¢¥¨¥
IF FutureFactP <> 0 THEN FutureFactP = 0 ELSE FactP = FutureFactP: FutureFactP = 1: Collis = 1
END IF
ELSE
'SPRITEPUT 2, 0, OXp, OYp, Sprite1(1)
Coll = SPRITECOLLDETECT%(0, X, Y, Xp, Yp, Sprite(1), Sprite2(1))
IF FutureFactP <> 0 THEN
'SPRITEPUT 1, 0, Xp, Yp, Sprite2(1)
ELSE
'DRWFILLBOX 1, 0, OXp, OYp - StepX!(Tip) - Speed, OXp + StepX!(Tip), OYp + Speed + StepX!(Tip)
RenderShip X, Y, Side, Pl, k, Hnds()
END IF
IF Coll = 2 THEN '…᫨ ¯à®¨§®è«® á⮫ª®¢¥¨¥
IF FutureFactP <> 0 THEN FutureFactP = 0 ELSE FactP = FutureFactP: FutureFactP = 1: Collis = 1
END IF
END IF
END IF
Pzs = -Pzs
IF Collis = 1 THEN '€ «¨§ á⮫ª®¢¥¨ï
Collis = 0
SELECT CASE Tip
CASE 3, 4 'Š ¬ã誨
IF k <> 2 THEN
IF FactProt = 0 THEN
k = 2: Y = Y + 5
RenderShip X, Y, Side, Pl, k, Hnds()
GoSound 1, PlayingSound, StartedSB
HStolk = HStolk + 1
ELSE 'ˆ§ ‡€™ˆ™…ŽƒŽ ¤¥« ¥âáï ¯à®áâë¬:
FactProt = 0
k = 1: Y = Y - 8
RenderShip X, Y, Side, Pl, k, Hnds()
GoSound 2, PlayingSound, StartedSB
END IF
ELSE 'Š îª...
GameOver = 1
GoSound 3, PlayingSound, StartedSB
Speed = 0
END IF
DeltaStars = 10
MakeExplosion X, Y, Xp, Yp, DeltaStars
CASE IS = 6 '‡€™ˆ’€
HSheeld = HSheeld + 1
IF FactProt <> 1 THEN
IF k = 1 THEN
FactProt = 1
k = 5: Y = Y + 8
RenderShip X, Y, Side, Pl, k, Hnds()
GoSound 4, PlayingSound, StartedSB
ELSE
GoSound 8, PlayingSound, StartedSB
END IF
END IF
CASE IS = 7 '€’…—Š€
FactTremble = 0
IF k = 2 THEN k = 1: Y = Y - 5: GoSound 5, PlayingSound, StartedSB
CASE IS = 8 ' ‘“…-—€‰ˆŠ-“‘ŠŽˆ’…‹œ
HSpeed = HSpeed + 1
Speed = Speed + 3: IF Speed > 20 THEN Speed = 20
GoSound 6, PlayingSound, StartedSB
CASE IS = 9
HTras = HTras + 1
FactTremble = 1 'Žâ ’Ž“‘€ - âàïáãçª ...
GoSound 7, PlayingSound, StartedSB
END SELECT
END IF
END IF
RenderStars X, Y, DeltaStars, Speed
'‚ëç¨á«ï¥¬ ¯à®©¤¥ë© ¯ãâì
PathLast = PathLast + Speed / 3
IF PathLast > 25555 AND FactP = 0 AND FactOvr = 0 THEN
FactOvr = 1: Tip = 10: FactP = 1: Yp = -200: Xp = 270
MyPCXOPEN 1, "JUPITER" '‡ £à㦠¥¬ ª à⨪ã á® á¯à ©â ¬¨
END IF
IF FactOvr = 3 THEN GameOver = 2: WinOK = 1
OPathLast = PathLast
IF FactOvr = 1 THEN
IF PathLast MOD 12 = 0 THEN
Speed = Speed / 2
IF Speed < 3 THEN Speed = 3: FactOvr = 2
IF Speed > 10 THEN Speed = Speed / 2
END IF
END IF
IF FactOvr = 2 OR FactOvr = 1 THEN
IF Yp > Y - 150 OR Yp > 300 THEN FactOvr = 3
END IF
ChangedShip = 0
IF GameOver > 0 AND PlayingSound = 0 THEN EXIT DO
IF GameOver = -1 THEN EXIT DO
LOOP
'?????????????????????????????????????????????????????????????????????????????
'GAMEOVERGAMEOVERGAMEOVERGAMEOVERGAMEOVERGAMEOVERGAMEOVERGAMEOVERGAMEOVERGAMEO
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
FOR k = 1 TO 9
FOR ai = 1 TO Forms(k)
IF Hnds(k, ai) <> 0 THEN NIL = XMSFREE(Hnds(k, ai))
NEXT ai
NEXT k
FOR k = 1 TO 50
IF HandTemp(k) <> 0 THEN NIL = XMSFREE(HandTemp(k))
NEXT k
StopMIDI
SLEEP
FMVolume 15, 15, 0
SELECT CASE GameOver
CASE IS = 1
'NIL = PCXGETINFO(PathG$ + "gover.pcx", NIL, NIL, NIL, PAL)
MatchPalette PAL$, 255
NIL = PAGEACTIVE(1)
'NIL = PCXPUT(1, 0, 0, PathG$ + "gover.pcx")
'PALSET PAL, 0, 255
NIL = PAGEDISPLAY(0, 0, 1)
FMVolume 10, 10, 0
REDIM MIDI%(BytesRequired&(Pat$ + "over.mid") \ 2)
LoadAndPlayMIDI Pat$ + "over.mid", VARSEG(MIDI%(0)), VARPTR(MIDI%(0))
WaitKey
CASE IS = 2
'PALCHGAUTO PAL, PAL2, 0, 255, 10
'NIL = PCXGETINFO(PathG$ + "win.pcx", NIL, NIL, NIL, PAL)
MatchPalette PAL$, 255
NIL = PAGEACTIVE(1)
'NIL = PCXPUT(1, 0, 0, PathG$ + "win.pcx")
NIL = PAGEDISPLAY(0, 0, 1)
'PALCHGAUTO PAL2, PAL, 0, 255, 10
DTime = CINT(TIMER - StartTIME&)
STime$ = LTRIM$(RTRIM$(STR$(DTime)))
ERASE Sprite, Sprite1, Sprite2
DIM Counter(5000)
NIL = PAGEACTIVE(0)
'NIL = PCXPUT(1, 1, 0, PathG$ + "counter.pcx")
s = 14
FOR i = 1 TO LEN(STime$)
cr = VAL(MID$(STime$, i, 1))
NIL = PAGEACTIVE(0)
'BLKGET 9 + cr * s, 2, 9 + cr * s + s - 1, 50, Counter(1)
NIL = PAGEACTIVE(1)
'SPRITEPUT 1, 0, 15 + (i - 1) * (s + 2), 374, Counter(1)
NEXT i
ERASE Counter
IF HStolk >= 2 THEN Mdl = 1
IF HStolk <= 1 AND HTras = 0 AND HSheeld >= 1 THEN Mdl = 2
IF Mdl > 0 THEN
NIL = PAGEACTIVE(0)
NmFm$ = PathG$ + "m" + LTRIM$(RTRIM$(STR$(Mdl))) + ".pcx"
'NIL = PCXPUT(1, 0, 0, NmFm$)
DIM Medal(7000)
'BLKGET 45, 35, 190, 190, Medal(0)
NIL = PAGEACTIVE(1)
'SPRITEPUT 1, 252, 10, 170, Medal(0)
ERASE Medal
END IF
OMdl = Mdl
IF HStolk = 0 THEN
IF HTras = 0 THEN Mdl = 3 ELSE IF HSpeed > 5 THEN Mdl = 4 ELSE IF HTras = 1 THEN Mdl = 5
END IF
IF Mdl > 0 THEN
NIL = PAGEACTIVE(0)
NmFm$ = PathG$ + "m" + LTRIM$(RTRIM$(STR$(Mdl))) + ".pcx"
'NIL = PCXPUT(1, 0, 0, NmFm$)
DIM Medal(7000)
'BLKGET 45, 35, 190, 190, Medal(0)
NIL = PAGEACTIVE(1)
IF OMdl <> 0 THEN
'SPRITEPUT 1, 252, 110, 170, Medal(0)
ELSE
'SPRITEPUT 1, 252, 10, 170, Medal(0)
END IF
ERASE Medal
END IF
FMVolume 10, 10, 0
REDIM MIDI%(BytesRequired&(Pat$ + "win.mid") \ 2)
LoadAndPlayMIDI Pat$ + "win.mid", VARSEG(MIDI%(0)), VARPTR(MIDI%(0))
'=================
Titres ' |
'=================
END SELECT
StopMIDI
NIL = RESTEXT
CLEAR
END
SetArraysOfData:
' Œ âà¨æ : StartX, StartY, StepX!, DeltaSizY, Forms, CorrX!:
DATA 0, 10, 55 , 0, 7 ,0
DATA 0, 60, 55 , 0, 7 ,0
DATA 7,115, 27 , 0, 16,-.3
DATA 7,155, 29 , 0, 15,0
DATA 0,195, 55 , 0, 7 ,0
DATA 0,248,53.3, -5, 12,0
DATA 0,300,53.3, -5, 12,0
DATA 0,354,53.3, -5, 12,0
DATA 0,409,53.4,-15, 12,0
DATA 0,250,100 ,0 , 6,0
RESTORE
FOR i = 1 TO 10
READ StartX(i)
READ StartY(i)
READ StepX!(i)
READ DeltaSizY(i)
READ Forms(i)
READ CorrX!(i)
NEXT i
'Œ âà¨æ á 梥⠬¨ §¢¥§¤
DATA 10 ,23 ,70 ,95 ,123,219,245
DATA 59 ,135,109,135,194,197,214
FOR i = 1 TO 14
READ StarColors(i)
NEXT i
MaxNumStars = 15
FOR i = 1 TO MaxNumStars
StarX(i) = RND * 640
StarY(i) = RND * 480
StarSpeed(i) = RND * 1 + 1
StarC(i) = StarColors(INT(RND * 14 + 1))
NEXT i
'Medal1 = 0
RETURN
SetSB:
GetBLASTER Channel%, BasePort%, IRQ% ' Parses BLASTER environment
NIL = ResetDsp%
SpeakerState 1 'turn the speaker on
MasterVolume 15, 15, -1 'this puts the mixer volumes in Right% and Left%
'MasterVolume 1, 13, 0 '15,15,0 cranks the master volume all the way up.
RETURN
REM $STATIC
FUNCTION BytesRequired& (FileName$)
'Open the file.
FF% = FREEFILE
OPEN FileName$ FOR BINARY AS #FF%
'Store the length of the file.
FileLen& = LOF(FF%)
'Close the file.
CLOSE FF%
'If the length of the file is 0, assume it does not exist and delete it.
IF FileLen& = 0 THEN KILL FileName$
'Return the length of the file as the number of bytes required.
BytesRequired& = FileLen&
MIDI.ERROR = 0
END FUNCTION
FUNCTION CheckIn (Xc, Yc, X1, Y1, X2, Y2)
IF Xc > X1 AND Yc > Y1 AND Xc < X2 AND Yc < Y2 THEN
CheckIn = 1
ELSE
CheckIn = 0
END IF
END FUNCTION
FUNCTION CheckIntersection (X1a, Y1a, X2a, Y2a, X1b, Y1b, X2b, Y2b)
'஢¥àª ¯¥à¥á¥ç¥¨ï 2-å ¯àאַ㣮«ì¨ª®¢:
CheckIntersection = 1
IF X1a > X2b OR X1b > X2a THEN CheckIntersection = 0
IF Y1a > Y2b OR Y1b > Y2a THEN CheckIntersection = 0
END FUNCTION
SUB ClearKeys
FOR j = 1 TO 32: i$ = INKEY$: NEXT j
END SUB
SUB DMAPlay (Segment&, Offset&, Length&, Freq&)
' Transfers and plays the contents of the buffer.
Length& = Length& - 1
Page% = 0
MemLoc& = Segment& * 16 + Offset&
SELECT CASE Channel%
CASE 0
PgPort% = &H87
AddPort% = &H0
LenPort% = &H1
ModeReg% = &H48
CASE 1
PgPort% = &H83
AddPort% = &H2
LenPort% = &H3
ModeReg% = &H49
CASE 2
PgPort% = &H81
AddPort% = &H4
LenPort% = &H5
ModeReg% = &H4A
CASE 3
PgPort% = &H82
AddPort% = &H6
LenPort% = &H7
ModeReg% = &H4B
CASE ELSE
'PRINT "DMA channels 0-3 only are supported."
EXIT SUB
END SELECT
OUT &HA, &H4 + Channel%
OUT &HC, &H0
OUT &HB, ModeReg%
OUT AddPort%, MemLoc& AND &HFF
OUT AddPort%, (MemLoc& AND &HFFFF&) \ &H100
IF (MemLoc& AND 65536) THEN Page% = Page% + 1
IF (MemLoc& AND 131072) THEN Page% = Page% + 2
IF (MemLoc& AND 262144) THEN Page% = Page% + 4
IF (MemLoc& AND 524288) THEN Page% = Page% + 8
OUT PgPort%, Page%
OUT LenPort%, Length& AND &HFF
OUT LenPort%, (Length& AND &HFFFF&) \ &H100
OUT &HA, Channel%
IF Freq& < 23000 THEN
timeconst% = 256 - 1000000 \ Freq&
WriteDSP &H40
WriteDSP timeconst%
WriteDSP &H14
WriteDSP (Length& AND &HFF)
WriteDSP ((Length& AND &HFFFF&) \ &H100)
ELSE
IF DSPVersion! >= 3 THEN
timeconst% = ((65536 - 256000000 \ Freq&) AND &HFFFF&) \ &H100
WriteDSP &H40
WriteDSP timeconst%
WriteDSP (Length& AND &HFF)
WriteDSP ((Length& AND &HFFFF&) \ &H100)
WriteDSP &H91
ELSE
'PRINT "You need a Sound Blaster with a DSP v3.x+ to play at high speed."
EXIT SUB
END IF
END IF
END SUB
SUB DMAState (StopGo%)
' Stops or continues DMA play.
IF StopGo% THEN WriteDSP &HD4 ELSE WriteDSP &HD0
END SUB
FUNCTION DSPVersion!
' Gets the DSP version.
WriteDSP &HE1
Temp% = ReadDSP%
Temp2% = ReadDSP%
DSPVersion! = VAL(STR$(Temp%) + "." + STR$(Temp2%))
END FUNCTION
SUB FMVolume (Right%, Left%, Getvol%)
OUT BasePort% + 4, &H26
IF Getvol% THEN
Left% = INP(BasePort% + 5) \ 16
Right% = INP(BasePort% + 5) AND &HF
EXIT SUB
ELSE
OUT BasePort% + 5, (Right% + Left% * 16) AND &HFF
END IF
END SUB
SUB GetBLASTER (DMA%, BasePort%, IRQ%)
' This subroutine parses the BLASTER environment string and returns settings.
IF LEN(ENVIRON$("BLASTER")) = 0 THEN PRINT "BLASTER environment variable not set.": EXIT SUB
FOR Length% = 1 TO LEN(ENVIRON$("BLASTER"))
SELECT CASE MID$(ENVIRON$("BLASTER"), Length%, 1)
CASE "A"
BasePort% = VAL("&H" + MID$(ENVIRON$("BLASTER"), Length% + 1, 3))
CASE "I"
IRQ% = VAL(MID$(ENVIRON$("BLASTER"), Length% + 1, 1))
CASE "D"
DMA% = VAL(MID$(ENVIRON$("BLASTER"), Length% + 1, 1))
END SELECT
NEXT
END SUB
FUNCTION GetBlasterAddr%
'Get Blaster Address and DMA channel from Environment Variable
tmp% = 0 'No Environment Variable Set...default
blast$ = UCASE$(ENVIRON$("BLASTER"))
IF LEN(blast$) THEN
tmp% = INSTR(blast$, "A")
tmp1$ = MID$(blast$, tmp% + 1, 3)
tmp% = VAL("&H" + tmp1$)
IF tmp% = 203 THEN tmp% = -1 'If there is no value assigned
IF tmp% > 0 THEN
tmp2% = INSTR(blast$, "D")
DMA% = VAL(MID$(blast$, tmp2% + 1)) 'dma% is a global variable
IF DMA% < 0 OR DMA% > 7 THEN tmp% = -2
END IF
END IF
GetBlasterAddr% = tmp%
END FUNCTION
FUNCTION GetKey$
Code = INP(&H60)
IF CHR$(Code) <> "p" THEN
Res = (INP(&H61) OR &H82)
OUT &H61, Res
OUT &H61, (Res AND &H7F)
END IF
'OUT &H61, &H61
OUT &H20, &H20
OUT &H61, 0
GK$ = CHR$(Code)
IF ASC(GK$) > 127 THEN ClearKeys
GetKey$ = GK$
END FUNCTION
SUB GoSound (SEvent, PlayingSound, StartedSB)
SELECT CASE SEvent
CASE IS = 1: IF RND > .5 THEN NS = 36 ELSE NS = 19 '“åã¤è¥¨¥
CASE IS = 2: IF RND > .5 THEN NS = 35 ELSE NS = 20 'Ž¡®à¬ «¨¢ ¨¥ (5->1)
CASE IS = 3 'Š îª
SELECT CASE CINT(RND * 3)
CASE IS = 0: NS = 33
CASE IS = 1: NS = 27
CASE IS = 2: NS = 56
CASE IS = 3: NS = 55
END SELECT
CASE IS = 4: IF RND > .5 THEN NS = 31 ELSE NS = 50 '‡ é¨â
CASE IS = 5: IF RND > .5 THEN NS = 51 ELSE NS = 44 '€¯â¥çª
CASE IS = 6: IF RND > .5 THEN NS = 38 ELSE NS = 10 '“᪮२¥
CASE IS = 7: IF RND > .5 THEN NS = 32 ELSE NS = 37 'Tpïáãçª
CASE IS = 8: IF RND > .5 THEN NS = 25 ELSE NS = 29 '‡ é¨â ¥ ¡¥à¥âáï...
END SELECT
PlaySB NS, PlayingSound, StartedSB
END SUB
SUB InitAndDetect
CLS
'*************************************************************************
'* LET'S ID THE VIDEO CARD/CHIP AS THE LIBRARY REQUIRES A SUPERVGA ADAPTER.
'*************************************************************************
NIL = RESTEXT
CPU = WHICHCPU
VGA = WHICHVGA
IF VGA < 1 THEN
STOP: END
END IF
'*************************************************************************
'* LET'S SEE THE HOW MUCH MEMORY IS INSTALLED ON THE SUPER VGA ADAPTER.
'*************************************************************************
VIDEOMEMORY = WHICHMEM
MEM$ = STR$(VIDEOMEMORY)
MEM$ = RIGHT$(MEM$, LEN(MEM$) - 1) + " kB"
IF VIDEOMEMORY < 1 THEN
STOP: END
END IF
'*************************************************************************
'* LET'S LOOK FOR A MOUSE. IF WE FIND ONE, TELL ALL ABOUT IT
'*************************************************************************
mouse = WHICHMOUSE
IF mouse > 0 THEN
MOUSEINFO MJV, MNV, TP, i
VER$ = STR$(MNV)
l = LEN(VER$)
VER$ = STR$(MJV) + "." + RIGHT$(VER$, l - 1)
VER$ = "Software driver version is" + VER$ + " (Microsoft equivalent version)."
ELSE
STOP: END
END IF
PRINT
'*************************************************************************
'* XMS MEMORY TEST
'*************************************************************************
Er = WHICHXMS(KB, HND)
IF Er = 0 THEN
STOP: END
END IF
'*************************************************************************
'* LET'S GET DOWN TO BUSINESS!
'*************************************************************************
Res = 1
ENDIT = 0
'*************************************************************************
'* INIT ALTERNATE COLOR PALETTES
'*************************************************************************
'Er = RES640
Er = RES800
IF MouseON = 1 THEN MOUSEENTER: MOUSESENSSET 14, 14, 1
END SUB
SUB InputSource (InputSrc%, GetSrc%)
OUT BasePort% + 4, &HC
IF GetSrc% THEN
InputSrc% = INP(BasePort% + 5) AND 2 + INP(BasePort% + 5) AND 4
ELSE
OUT BasePort% + 5, InputSrc% AND 7
END IF
END SUB
SUB KeySupport (INK$, X, Y, Side, ChangedShip, StGX, StGY, GameOver)
WaitVSync
SELECT CASE INK$
CASE IS = "K"
DRWFILLBOX 1, 0, X, Y, X + 55, Y + 55
X = X - StGX
Side = Side - 1
IF Side < -9 THEN Side = -9
ChangedShip = 1
FMVolume CINT(X / 50), CINT((640 - X) / 50), 0
CASE IS = "M"
DRWFILLBOX 1, 0, X, Y, X + 55, Y + 55
X = X + StGX
Side = Side + 1
IF Side > 9 THEN Side = 9
ChangedShip = 1
FMVolume CINT(X / 50), CINT((640 - X) / 50), 0
CASE IS = "H"
DRWFILLBOX 1, 0, X, Y, X + 55, Y + 55
Y = Y - StGY
ChangedShip = 1
CASE IS = "P"
DRWFILLBOX 1, 0, X, Y, X + 55, Y + 55
Y = Y + StGY
ChangedShip = 1
CASE IS = CHR$(1): GameOver = -1
CASE ELSE
ClearKeys
IF Y < 400 THEN Y = Y + (400 - Y) / 30 + 1: ChangedShip = 1
IF Y > 420 THEN Y = Y - 1: ChangedShip = 1
IF X < 50 THEN X = X + 1: ChangedShip = 1
IF X > 550 THEN X = X - 1: ChangedShip = 1
IF Side < 0 THEN Side = Side + 1: ChangedShip = 1
IF Side > 0 THEN Side = Side - 1: ChangedShip = 1
END SELECT
END SUB
SUB LineVolume (Right%, Left%, Getvol%)
OUT BasePort% + 4, &H2E
IF Getvol% THEN
Left% = INP(BasePort% + 5) \ 16
Right% = INP(BasePort% + 5) AND &HF
EXIT SUB
ELSE
OUT BasePort% + 5, (Right% + Left% * 16) AND &HFF
END IF
END SUB
SUB LoadAndPlayMIDI (FileName$, MIDISegment%, MIDIOffset%)
'See if an extension was supplied, and if not, add one.
IF INSTR(FileName$, ".") = 0 THEN FileName$ = FileName$ + ".MID"
'Open the file
FF% = FREEFILE
OPEN FileName$ FOR BINARY AS #FF%
FileLen& = LOF(1)
CLOSE #FF%
'If the file is empty, delete it and exit now.
IF FileLen& = 0 THEN KILL FileName$: MIDI.ERROR = 1: EXIT SUB
'If the file is too large, exit now.
IF FileLen& > 65535 THEN MIDI.ERROR = 2: EXIT SUB
'Make the filename an ASCIIZ string.
FileName$ = FileName$ + CHR$(0)
'Check if the MIDI loading code has already been loaded;
'if not, do it now.
IF LoadCodeLoaded% = 0 THEN
asm1$ = asm1$ + CHR$(&H1E)
asm1$ = asm1$ + CHR$(&H55)
asm1$ = asm1$ + CHR$(&H89) + CHR$(&HE5)
asm1$ = asm1$ + CHR$(&HB8) + CHR$(&H0) + CHR$(&H3D)
asm1$ = asm1$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HE)
asm1$ = asm1$ + CHR$(&H8B) + CHR$(&H17)
asm1$ = asm1$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H10)
asm1$ = asm1$ + CHR$(&H8E) + CHR$(&H1F)
asm1$ = asm1$ + CHR$(&HCD) + CHR$(&H21)
asm1$ = asm1$ + CHR$(&H89) + CHR$(&HC6)
asm1$ = asm1$ + CHR$(&HB4) + CHR$(&H3F)
asm1$ = asm1$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8)
asm1$ = asm1$ + CHR$(&H8B) + CHR$(&HF)
asm1$ = asm1$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HA)
asm1$ = asm1$ + CHR$(&H8B) + CHR$(&H17)
asm1$ = asm1$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&HC)
asm1$ = asm1$ + CHR$(&H8E) + CHR$(&H1F)
asm1$ = asm1$ + CHR$(&H89) + CHR$(&HF3)
asm1$ = asm1$ + CHR$(&HCD) + CHR$(&H21)
asm1$ = asm1$ + CHR$(&HB4) + CHR$(&H3E)
asm1$ = asm1$ + CHR$(&HCD) + CHR$(&H21)
asm1$ = asm1$ + CHR$(&H5D)
asm1$ = asm1$ + CHR$(&H1F)
asm1$ = asm1$ + CHR$(&HCA) + CHR$(&HA) + CHR$(&H0)
LoadCodeLoaded% = 1
END IF
'Call the assembly language routine.
DEF SEG = VARSEG(asm1$)
CALL ABSOLUTE(VARSEG(FileName$), SADD(FileName$), MIDISegment%, MIDIOffset%, &HFFFF, SADD(asm1$))
MIDI.ERROR = 0
'Check to see if the MIDI playing code has previously been loaded.
'If not, load it now.
IF PlayCodeLoaded% = 0 THEN
'Load the machine codes into a string.
asm2$ = asm2$ + CHR$(&H55)
asm2$ = asm2$ + CHR$(&H89) + CHR$(&HE5)
asm2$ = asm2$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H8)
asm2$ = asm2$ + CHR$(&H8B) + CHR$(&H17)
asm2$ = asm2$ + CHR$(&H8B) + CHR$(&H5E) + CHR$(&H6)
asm2$ = asm2$ + CHR$(&H8B) + CHR$(&H7)
asm2$ = asm2$ + CHR$(&HBB) + CHR$(&H4) + CHR$(&H0)
asm2$ = asm2$ + CHR$(&HCD) + CHR$(&H80)
asm2$ = asm2$ + CHR$(&HBB) + CHR$(&H5) + CHR$(&H0)
asm2$ = asm2$ + CHR$(&HCD) + CHR$(&H80)
asm2$ = asm2$ + CHR$(&H5D)
asm2$ = asm2$ + CHR$(&HCA) + CHR$(&H4) + CHR$(&H0)
'Indicate that the code has been loaded.
PlayCodeLoaded% = 1
END IF
'Call the machine language routine to play the music.
DEF SEG = VARSEG(asm2$)
CALL ABSOLUTE(MIDISegment%, MIDIOffset%, SADD(asm2$))
'Start the MIDI timer.
MIDI.PLAYTIME = TIMER
MIDI.ERROR = 0
END SUB
SUB MakeExplosion (X, Y, Xp, Yp, DeltaStars)
'â ¯à®æ¥¤ãà ¤¥« ¥â ¢§àë¢ (¯® áãâ¨, ¨§ §¢¥§¤...)
FOR i = MaxNumStars + 1 TO MaxNumStars + DeltaStars
StarX(i) = (Xp + X + 35) / 2 + RND * 25 - 12.5
StarY(i) = (Yp + Y) / 2 + RND * 30
StarSpeed(i) = RND * 2 + 6
StarC(i) = StarColors(INT(RND * 14 + 1))
StarDeltaX!(i) = (StarX(i) - (Xp + X + 35) / 2) * RND / 10
'DRWPOINT 1, StarC(i), StarX(i), StarY(i)
NEXT i
END SUB
SUB MasterVolume (Right%, Left%, Getvol%)
OUT BasePort% + 4, &H22
'PRINT BasePort%
IF Getvol% THEN
Left% = INP(BasePort% + 5) \ 16
Right% = INP(BasePort% + 5) AND &HF
EXIT SUB
ELSE
OUT BasePort% + 5, (Right% + Left% * 16) AND &HFF
END IF
END SUB
SUB MatchPalette (PAL$, NUMCOL)
'ˆá¯à ¢«¥¨¥ ¥ª®â®àëå ®è¨¡®ª ¢ ¯ «¨âॠPCX:
MIN& = (255 ^ 2) * 3
MAX& = 0
'*********************************************************************
'* WE NEED TO CHECK THE PCX COLOR PALETTE ENTRIES TO SEE IF ANY COLORS
'* ARE GREATER THE SIX BITS IN LENGTH AS THE VGA COLOR PALETTE
'* REGISTERS ARE ONLY SIX BITS WIDE. WE ALSO LOOK FOR THE BRIGHTEST
'* AND DARKEST COLORS TO USE AS OUR TEXT AND BACKGROUND COLORS
'*********************************************************************
FIXIT = 0
FOR a = 1 TO NUMCOL * 3 STEP 3
R = ASC(MID$(PAL$, a, 1))
G = ASC(MID$(PAL$, a + 1, 1))
b = ASC(MID$(PAL$, a + 2, 1))
IF R > 63 THEN
FIXIT = 1
END IF
IF G > 63 THEN
FIXIT = 1
END IF
IF b > 63 THEN
FIXIT = 1
END IF
TEST& = R ^ 2 + G ^ 2 + b ^ 2
IF TEST& < MIN& THEN
'* FIND THE DARKEST COLOR FOR THE BACKGROUND
MIN& = TEST&
MINCOLOR = a / 3
END IF
IF TEST& > MAX& THEN
'* FIND THE BRIGHTEST COLOR FOR THE TEXT
MAX& = TEST&
MAXCOLOR = a / 3
END IF
NEXT a
'*********************************************************************
'* IF THE PCX USES 8 BIT COLOR THEN WE SHIFT EACH COLOR ENTRY RIGHT
'* BY 2 BITS (THIS REDUCES IT TO 6 BITS OF COLOR)
'*********************************************************************
IF FIXIT = 1 THEN
FOR a = 1 TO NUMCOL * 3
C = ASC(MID$(PAL$, a, 1))
MID$(PAL$, a, 1) = CHR$(C \ 4)
NEXT a
END IF
'*********************************************************************
'* IF THE PCX HAS A PALETTE OF 128 COLORS OR LESS THEN WE CAN USE
'* OUR OWN COLORS FOR THE TEXT AND BACKGROUND
'*********************************************************************
IF NUMCOL < 128 THEN
MID$(PAL$, 763, 1) = CHR$(0) '* THIS IS THE COLOR BLACK
MID$(PAL$, 764, 1) = CHR$(0)
MID$(PAL$, 765, 1) = CHR$(0)
MINCOLOR = 254
MID$(PAL$, 766, 1) = CHR$(32) '* THIS IS THE COLOR MED WHITE
MID$(PAL$, 767, 1) = CHR$(32)
MID$(PAL$, 768, 1) = CHR$(32)
NUMCOL = 255
END IF
END SUB
SUB MyPCXOPEN (Page, FileName$)
'Žâªàë⨥ ¯®«®íªà ®£® PCX-ä ©« ¢ âॡ㥬ãî ¢¨¤¥®áâà ¨æã
FileName$ = PathG$ + FileName$ + ".PCX"
NIL = PCXGETINFO(FileName$, PCXXSize%, PCXYSize%, NumColors%, PAL)
MatchPalette PAL, 256
PALSET PAL, 0, 255
NIL = PAGEACTIVE(Page)
FILLVIEW (0)
NIL = PCXPUT(1, 0, 0, FileName$)
NIL = PAGEACTIVE(0)
END SUB
SUB PlayBack (buffer$, size%, Freq&, BytesPerSec&, chans%, Num%)
size% = size% - 1
Segment& = VARSEG(buffer$)
Offset& = SADD(buffer$)
IF Segment& < 0 THEN Segment& = Segment& + 65536
IF Offset& < 0 THEN Offset& = Offset& + 65536
baseaddr& = Segment& * 16 + Offset&
look1% = VARPTR(baseaddr&)
look2% = VARPTR(size%)