forked from microsoft/GW-BASIC
/
GWSTS.ASM
2348 lines (2170 loc) · 61.8 KB
/
GWSTS.ASM
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
; [ This translation created 10-Feb-83 by Version 4.3 ]
.RADIX 8 ; To be safe
CSEG SEGMENT PUBLIC 'CODESG'
ASSUME CS:CSEG
INCLUDE OEM.H
TITLE GWSTS - GW-BASIC Common Statement Support
COMMENT *
--------- --- ---- -- ---------
COPYRIGHT (C) 1982 BY MICROSOFT
--------- --- ---- -- ---------
*
;General Feature Switches (Not OEM Switches)
;
KANADT=0 ;Japanese date format("[yy]yy/mm/dd")
STKEYF=1D ;Start number of string function keys
IBMCSR=IBMLIK ;IBM comp. cursor interface
FKEYCR=74O ;CR character for F-KEY display line
GWLEV2=0 ;Version 2.0 of GW BASIC-86
;OEM Switches (ONLY INCLUDE IF ABSOLUTELY NECESSARY)
;
MCI=0
TETRA=0
MELCO=0
ZENITH=0
;Definition of scroll types
; Choice of scroll type is by switch SCROLT.
; Switches defined here are used to implement a specific SCROLT type.
; If other scroll types are needed then additional SCROLT types should be
; defined here.
INVLIN=SCROLT ;Invisible (function key) Line
FKFSRL=(SCROLT-1) AND 1 ;Clear fkeys/full scroll/rewrite fkeys
;Local Switches
;
KEYFSW=0 ;No KEY Function
INTHND=SCP ;MSDOS Ctl-C interrupt handler
CLRFMT=(MELCO-1) AND (ZENITH-1) ;New COLOR parameter format
FKEYCR=27D ;IBM CR FKey display line graphic
.SALL
.RADIX 10
EXTRN CHRGTR:NEAR,SYNCHR:NEAR,SNERR:NEAR,FCERR:NEAR,GETBYT:NEAR
EXTRN USERR:NEAR
IF CPM86
CPMXIO MACRO DFUN
MOV CL,LOW OFFSET DFUN
INT 340O ;CPM86 system call
ENDM
ENDIF
DOSIO MACRO DFUN
MOV AH,LOW OFFSET DFUN
INT 33 ;MS-DOS system call
ENDM
GDAT=42D ;MS-DOS Get Date Function
SDAT=43D ;MS-DOS Set Date Function
GTIM=44D ;MS-DOS Get Time Function
STIM=45D ;MS-DOS Set Time Function
PUBLIC PATCHG
PATCHG: DB 500D DUP(?) ;GW patch space
PAGE
SUBTTL CLS,LOCATE,WIDTH (of screen),LCOPY
PUBLIC CLS,LOCATE,GWWID,LCOPYS,COLOR,GETLIN,SCRENF,SCREEN
DSEG SEGMENT PUBLIC 'DATASG'
ASSUME DS:DSEG
EXTRN LINCNT:WORD,LINLEN:WORD,CSRY:WORD,CSRX:WORD,BUF:WORD
DSEG ENDS
EXTRN GETFBC:NEAR
EXTRN SCRSTT:NEAR,SCRATR:NEAR
EXTRN SETCLR:NEAR,SWIDTH:NEAR
EXTRN LCPY:NEAR
COMMA=","
OPAREN="("
CPAREN=")"
QUOTE=34D
BKSPC=8D
CR=13D
LF=10D
PAGE
;CLS: CLear Screen issues an escape sequence to clear
; the CRT. Sequences are ANSII standard whereas the machine
; default is not. CLS resets the graphics cursor position.
;ENTRY - none
;EXIT - none
;USES - none
;
EXTRN CLRSCN:NEAR
CLS: CALL SCNINT ;Test for optional parameter
CMC
PUSHF
PUSH AX
CALL EOSCHK ;Test for end of statement
POP AX
POPF
PUSH BX
CALL CLRSCN
POP BX
RET
PAGE
;LOCATE: Parse the following syntax:
; LOCATE [Y] [, [X] [, [CURSOR] [, [START] [, [STOP] ]]]
;
EXTRN SCNPOS:NEAR
LOCATE: CALL SCNINT ;Get optional Y parameter
JNB YLCPRM ;Parameter present
CALL GTLINE ;Get the current screen position
YLCPRM: MOV DL,AL
OR AL,AL ;Test for LOCATE 0
JZ GOFCER
SUB DL,BYTE PTR KEYSW ;Increment if PF-keys are displayed
CMP DL,BYTE PTR LINCNT ;Check for parameter range
JA GOFCER
PUSH AX ;Save new Y location
CALL SCNINT ;Get optional X parameter
JNB XLCPRM ;Parameter present
CALL SCNPOS ;Get the current screen position
MOV AL,DH ;Default to current cursor position
XLCPRM: MOV DL,AL
DEC DL ;Dissallow LOCATE ,0
CMP DL,BYTE PTR LINLEN ;Check for parameter range
JAE GOFCER
PUSH AX ;Save new X
CALL SCNINT ;Cursor on/off - 0=off else on
EXTRN CSRATR:NEAR
MOV AH,LOW 377O ;Ensure non-zero
JNB LOCPR1 ;Parameter 1 found
XOR AH,AH ;Flag as a default
LOCPR1: PUSH AX ;Push first parameter and flag
CALL SCNINT ;Get next parameter
MOV AH,LOW 377O ;Ensure non-zero flag
JNB LOCPR2 ;Parameter 2 found
XOR AH,AH ;Flag as a default
LOCPR2: PUSH AX ;Push second parameter and flag
CALL SCNINT ;Get next parameter
MOV AH,LOW 377O ;Ensure non-zero flag
JNB LOCPR3 ;Parameter 3 found
XOR AH,AH ;Flag as a default
LOCPR3: PUSH AX ;Push third parameter
CALL EOSCHK ;Check for end of statement
MOV DX,BX ;Save text pointer
POP CX
POP BX
POP AX ;Recover three parameters
PUSH DX ;Save text pointer
CALL CSRATR ;Set Cursor Attribute (OEM routine)
JB GFCERR ;Declare error from CSRATR
POP BX ;Text pointer
SETLOC: MOV AX,BX
POP CX
POP BX
PUSH AX
MOV BH,CL
EXTRN SCNLOC:NEAR
MOV AX,BX
CALL SCNLOC ;position cursor at line [AL], col [AH]
DSEG SEGMENT PUBLIC 'DATASG'
EXTRN CSRTYP:WORD
DSEG ENDS
EXTRN CSRDSP:NEAR
MOV DX,AX ;Load cursor position
MOV AL,LOW 3D ;Signal for user cursor
CALL CSRDSP ;Set cursor
POP BX ;Restore text pointer
RET
GOFCER: JMP FCERR
PAGE
;GWWID: Parsing for WIDTH [X] [, [Y]]
;ENTRY - WIDTH LPRINT is not a possibility at this point.
;EXIT - AL = X param
; BX = text pointer
;
GWWID: CALL SCNINT ;Get X dimension
JNB XPRAM ;X param found
MOV AL,BYTE PTR LINLEN ;Use current as default
XPRAM: PUSH AX ;Save for RET to WIDTH
PUSH AX ;Save for GWWID use
CALL SCNINT ;Get Y dimension
JNB YPRAM ;Y param found
MOV AL,BYTE PTR LINCNT ;Use current as default
YPRAM: PUSH AX
CALL EOSCHK ;Must be at end of statement
POP AX
CMP AL,BYTE PTR LINCNT ;Set CC's for Y dimension change
LAHF
MOV CX,AX
POP AX
CMP AL,BYTE PTR LINLEN ;Set CC's for X dimension change
LAHF
AND AH,CH ;Set CC's for X OR Y change
SAHF
JZ GWWIDX ;No change - done
PUSH BX ;Save text pointer
PUSH AX ;save Width
PUSH CX ;save Height
CALL SWIDTH ;Machine dependent set logic
POP CX
POP AX
JB GFCERR ;Error detected within SWIDTH
POP BX ;Restore text pointer
GWWIDX: POP AX ;Return X dimension for WIDTH
RET
GFCERR: JMP FCERR
PAGE
;LCOPY: Copy the screen to the line printer.
;ENTRY - BX = text pointer
;EXIT - BX = text pointer
LCOPYS: MOV DL,LOW 0 ;default parm is 0
JZ NOPARM ;branch if end-of-statement
CALL GETBYT ;[DL]=parm
NOPARM: CALL EOSCHK ;Check for unwanted parameters
PUSH BX ;Save text pointer
CALL LCPY
JB GFCERR ;Error detected in low level routine
POP BX
RET
PAGE
SUBTTL COLOR,GETLIN,SCREEN (function and statement)
;COLOR: Set the foreground, background, and boarder attributes.
; SYNTAX - COLOR [FOR] [,BACK [,BOARD]]
; Where - FOR = Foreground attribute
; BACK = Background attribute
; BOARD = Boarder attribute
;
COLOR: CALL GTPRMS ;Get arbitrary number of int. parms.
COLOR1: PUSH BX ;Save text pointer
MOV BX,DI ;Get parameter buffer pointer
CALL SETCLR ;Check colors for validity
JB GFCERR ;Error detected by low level routine
POP BX
RET
PAGE
;GETLIN: Obtain the current cursor line number.
;EXIT - FAC = cursor line number
; BX preserved
DSEG SEGMENT PUBLIC 'DATASG'
EXTRN LINLEN:WORD,LINCNT:WORD,KEYSW:WORD
DSEG ENDS
GETLIN: CALL GTLINE
PUSH BX
XOR BX,BX
MOV BL,AL
CALL MAKINT
POP BX
CALL CHRGTR
RET
;GTLINE: Get the line number of the character position to which the next
;character would be written.
;Entry - none
;Exit - [AL] = line number
;Uses - AH
;
GTLINE: MOV AL,BYTE PTR CSRY ;BX = cursor line number
MOV AH,BYTE PTR CSRX
CMP AH,BYTE PTR LINLEN
JBE GETLN0 ;BRIF will not wrap before next char is output
MOV AH,BYTE PTR LINCNT ;AL=last valid line number
DEC AH ;Scroll always occurs on line [LINCNT]-1
CMP AL,AH
JAE GETLN0 ;BRIF wrap will cause scroll
INC AL ;Else wrap will cause line number increment
GETLN0: RET
PAGE
;SCRENF: Obtain character from screen.
SCRENF:
CALL CHRGTR ;Eat the SCREEN token since SCREEN is
;defined as a statement and the function
;is dispatched to by EVAL.
CALL SYNCHR
DB OFFSET OPAREN ;Check for "("
CALL SCNINT ;Get Y parameter
JB FCERGO ;Parameter not present
DEC AL
CMP AL,BYTE PTR LINCNT ;Check range [1,LINCNT]
JAE FCERGO ;Out of range
INC AL
PUSH AX ;Y param.
CALL SCNINT ;Check for X param
JB FCERGO ;Error - no X param
DEC AL
CMP AL,BYTE PTR LINLEN ;Check range [1,LINLEN]
JAE FCERGO ;Out of range
INC AL
PUSH AX ;X param.
CMP AH,LOW OFFSET CPAREN ;Check terminator
JE SCRCHR ;End of params - go get char.
CALL SCNINT
JB FCERGO ;Error - no CPAREN and no Z param.
CMP AH,LOW OFFSET CPAREN ;Must now have CPAREN
JNE FCERGO
CMP AL,LOW 00O ;Is Z zero?
JE SCRCHR ;Yes - go get screen character
POP AX ;Retrieve X param
POP CX ;Retrieve Y param
PUSH BX ;Save text pointer
MOV BX,CX ;Call SCRATR with AX=X,BX=Y
CALL SCRATR ;Get screen attributes
JMP SHORT SCRENX
FCERGO: JMP FCERR
SCRCHR: POP AX ;Retrieve col number
POP CX ;Retrieve row number
PUSH BX ;Save the text pointer
EXTRN SCRINP:NEAR
PUSH DX
MOV DL,CL
MOV DH,AL
STC ;Indicate call is from SCREEN function
CALL SCRINP ;[AX]=Read char at (DH,DL)
MOV BX,AX ;return result in BX
POP DX
SCRENX: CALL MAKINT ;Set FAC
POP BX ;Retrieve text pointer
DEC BX
CALL CHRGTR
RET
PAGE
;SCREEN: This statement has no standard syntax. It is handled
; by parsing single byte integers until end of statement.
; Parameters may be null (appearance of a comma before an
; expression is encountered).
; SCRSTT (machine dependent) is called to process parameters
; which are in a list which is headed by a one word parameter
; count. The remaining list entries are two bytes long.
; The first byte is 0 if the SCREEN parameter was null.
; The second byte is the parameter value if it is nonnull
; or meaningless (if the parameter was null).
SCREEN: CALL GTPRMS ;Get single byte integer parms
PUSH BX
MOV BX,DI
CALL SCRSTT ;Process params
JB FCERGO ;Error detected in low level routine
POP BX ;Restore text pointer
RET
GTPRMS: MOV DI,OFFSET BUF ;Parameters stored in BUF
XOR CX,CX ;Initialize parameter count
INC DI ;Reserve parameter count location
SCRLOP: INC CX ;Count the param
PUSH CX
PUSH DI
CALL SCNINT ;Look for a parameter
POP DI
POP CX
JZ STTEND ;End of statement encountered
JNB PRMFND ;Parameter found (AH = separator)
XOR AX,AX ;Indicate a null parameter
PRMFND: XCHG AH,AL
MOV WORD PTR 0[DI],AX ;Load parameter to list
INC DI ;Next list entry
INC DI
JMP SHORT SCRLOP ;Go get next param
STTEND: JB NOPRM
MOV BYTE PTR 0[DI],LOW 255D ;Set param. exists flag
MOV BYTE PTR 1[DI],AL
INC CX
NOPRM: DEC CX
MOV DI,OFFSET BUF ;Reset list index
MOV BYTE PTR 0[DI],CL ;Head list with param count
RET
PAGE
SUBTTL PUT & GET (Distinguish Disk from Graphics)
PUBLIC PUT,GET
EXTRN DPUTG:NEAR,GPUTG:NEAR
;PUT: This code parses enough of the PUT/GET statement to
;GET: distinguish between the graphics and disk versions of
; these commands.
; The accepted technique is to search for a "(". This
; does not always allow for file number expressions which begin
; with "(".
;ENTRY: [BX] points to the character following the token.
;EXIT - Exit is made by jumping to the appropriate PUT/GET
; code.
; [BX] - restored to entry value before call of PUT/GET code.
PUT: MOV CX,1 ;Set PUT flag
JMP PARSE
GET: XOR CX,CX ;Set GET flag
PARSE: PUSH CX ;Save indication of PUT or GET
PUSH BX ;Save text pointer
CMP AL,LOW "(" ;Test for "("
JE GRPVER ;branch if graphics version
CMP AL,LOW "@" ;test for relative GET/PUT
JNE DSKVER ;Disk code may have no "(" or "@"
GRPVER: POP BX ;Restore text pointer
POP AX
JMP GPUTG ;Go to graphics PUT/GET
DSKVER: POP BX ;Restore text pointer
POP AX ;Get PUT/GET flag
JMP DPUTG
PAGE
SUBTTL Parsing Routines for GWSTS
PUBLIC SCNINT,EOSCHK
;SCNINT: Test for an optional integer parameter.
; If a comma or EOL is discovered assume parameter is missing.
; Otherwise evaluate the parameter.
;EXIT - [AL] = parameter value
; C set - no parameter found
; C reset - parameter found
;USES - ALL
SCNINT: DEC BX
CALL CHRGTR
JZ NOMORE ;EOL - Param null
CMP AL,LOW OFFSET COMMA
JZ OMITD ;Comma found. Param null.
CALL GETBYT ;Evaluate parameter
PUSH AX ;Save parameter
DEC BX ;Prepare to test expression terminator
CALL CHRGTR
JZ TRMOK ;EOL caused termination - OK
CMP AL,LOW OFFSET COMMA
JZ TRMCOM ;Comma caused termination - OK
CMP AL,LOW OFFSET CPAREN ;CPAREN caused termination - OK
JZ TRMCOM
POP AX ;Retrieve param.
JMP FCERR ;All other terminators not OK
TRMCOM: INC BX ;Move over comma
TRMOK: MOV CL,AL ;Save terminator
POP AX ;Retrieve parameter value
MOV AH,CL ;Return with AH = terminator
CLC ;Flag param. found
RET
OMITD: INC BX
NOMORE: MOV AH,AL ;Save terminator
MOV AL,LOW 0D ;Set param value to 0, save flags
STC ;Flag param. not found
RET
PAGE
;EOSCHK: Detect garbage beyond end of statement
;ENTRY - BX = text pointer
;EXIT - AL = 0 & all other registers preserved or
; - Exit on error through FCERR
;
EOSCHK:
DEC BX ;Back up text pointer
EOSCH1:
CALL CHRGTR ;Get next character (skipping blanks)
JZ EOSCKX ;End of statement
JMP SNERR ;Not EOS - error
EOSCKX: RET
PAGE
SUBTTL Graphics Support Specific to the 8086
PUBLIC LINLP3
DSEG SEGMENT PUBLIC 'DATASG'
EXTRN MINDEL:WORD,MAXDEL:WORD,MINUPD:WORD,MAXUPD:WORD
DSEG ENDS
EXTRN SETC:NEAR
;LINLP3: Inner loop of line code.
LINLP3: CALL SETC ;SET CURRENT POINT
ADD DX,WORD PTR MINDEL ;ADD SMALL DELTA TO SUM
CMP DX,WORD PTR MAXDEL ;TIME TO UPDATE MINOR?
JB LINLOP ;NO, UPDATE MAJOR AND CONTINUE
SUB DX,WORD PTR MAXDEL ;UPDATE SUM FOR NEXT POINT
CALL WORD PTR MINUPD+1 ;ADVANCE MINOR AXIS
LINLOP: CALL WORD PTR MAXUPD+1 ;UPDATE MAJOR AXIS
LOOP LINLP3 ;CONTINUE UNTIL COUNT EXHAUSTED
RET
PAGE
SUBTTL VARPT2 - VARPTR$ Function
PUBLIC VARPT2
EXTRN PTRGTN:NEAR
DSEG SEGMENT PUBLIC 'DATASG'
EXTRN VALTYP:WORD,DSCPTR:WORD
DSEG ENDS
;VARPTR$(x)
; Called after VARPTR sees next char is "$"
; Returns 3 byte string as follows:
; byte 0: type of x
; byte 1: low-adr of varptr(x)
; byte 2: high-adr of varptr(x)
; Primary use is so BASCOM can handle DRAW "X"+VARPTR$(A$)
;
VARPT2:
CALL CHRGTR ;get byte after "$"
CALL SYNCHR
DB OFFSET "(" ;EAT LEFT PAREN
CALL PTRGTN ;GET ADDRESS OF VARIABLE
CALL SYNCHR
DB OFFSET ")" ;EAT RIGHT PAREN
OR DX,DX ;MAKE SURE NOT UNDEFINED VAR
JNZ VARRT2 ;SET CC'S. ZERO IF UNDEF
JMP FCERR ;ALL OVER IF UNDEF (DONT WANT
;USER POKING INTO ZERO IF HE'S
;TOO LAZY TO CHECK
VARRT2:
PUSH BX ;Save text pntr
PUSH DX ;Save Var addr
MOV AL,BYTE PTR VALTYP
PUSH AX ;Save type
MOV AL,LOW 3
CALL STRINI ;Get a 3 byte string
MOV BX,WORD PTR DSCPTR ;Descriptor in [BX]
POP WORD PTR 0[BX] ;Store Type in Byte 1
INC BX
POP WORD PTR 0[BX] ;Store addr in Bytes 2-3.
JMP PUTNEW ;Desc in FAC & ret. ([BX] on stack).
PAGE
SUBTTL PLAY/SOUND statements
;
; PLAY - MUSIC MACRO LANGUAGE
;
PUBLIC PLAYS
EXTRN DONOTE:NEAR
EXTRN MACLNG:NEAR,MCLXEQ:NEAR,FETCHR:NEAR,DECFET:NEAR,VALSC2:NEAR
EXTRN FETCHZ:NEAR
;Low-Level routine required:
; DONOTE(AL: voice (0=forground, 1=back), CX:frequency, DX:duration (1=18.7ms))
; queues note for execution, saves all regs.
;
PLAYS: MOV DX,OFFSET PLYTAB ;POINT TO PLAY COMMAND TABLE
JMP MACLNG
PLYTAB: DB "A" ;THE NOTES A-G
DW OFFSET PLYNOT
DB "B"
DW OFFSET PLYNOT
DB "C"
DW OFFSET PLYNOT
DB "D"
DW OFFSET PLYNOT
DB "E"
DW OFFSET PLYNOT
DB "F"
DW OFFSET PLYNOT
DB "G"
DW OFFSET PLYNOT
DB "M" ;Music Meta Command
DW OFFSET PLYMET
DB OFFSET "N"+128D ;PLAY NUMERIC NOTE
DW OFFSET PLYNUM
DB OFFSET "O"+128D ;OCTAVE
DW OFFSET POCTAV
DB OFFSET "P"+128D ;PAUSE
DW OFFSET PPAUSE
DB OFFSET "T"+128D ;TEMPO
DW OFFSET PTEMPO
DB OFFSET "L"+128D ;LENGTH
DW OFFSET PLYLEN
DB "X" ;EXECUTE STRING
DW OFFSET MCLXEQ
DB 00 ;END OF TABLE
; TABLE OF INDEXES INTO NOTTAB FOR EACH NOTE
; VALUE OF 255 MEANS NOTE NOT ALLOWED.
NOTXLT: DB OFFSET 9D*2 ;A- (G#)
DB OFFSET 10D*2 ;A
DB OFFSET 11D*2 ;A#
DB OFFSET 12D*2 ;B
DB 255D ;NO C- OR B#
DB OFFSET 1D*2 ;C
DB OFFSET 2D*2 ;C#
DB OFFSET 3D*2 ;D
DB OFFSET 4D*2 ;D#
DB OFFSET 5D*2 ;E
DB 255D ;NO E# OR F-
DB OFFSET 6D*2 ;F
DB OFFSET 7D*2 ;F#
DB OFFSET 8D*2 ;G
DB OFFSET 9D*2 ;G#
; TABLE OF NOTE FREQUENCIES
; THESE ARE THE FREQUENCIES IN HERTZ OF THE TOP OCTAVE (6)
; DIVIDED DOWN BY POWERS OF TWO TO GET ALL OTHER OCTAVES
;
NOTTAB: DW 4186D ;C
DW 4435D ;C#
DW 4699D ;D
DW 4978D ;D#
DW 5274D ;E
DW 5588D ;F
DW 5920D ;F#
DW 6272D ;G
DW 6645D ;G#
DW 7040D ;A
DW 7459D ;A#
DW 7902D ;B
PLYLEN: JNB PLGOFC ;ERROR IF NO ARG
CMP DL,LOW 65D ;ALLOW ONLY UP TO 64
JNB PLGOFC ;FC ERROR IF TOO BIG
OR DL,DL ;DON'T ALLOW ZERO
JZ PLGOFC ;FC ERROR IF ZERO
MOV BYTE PTR NOTELN,DL ;STORE NOTE LENGTH
RET
PTEMPO: CMP DL,LOW 32D ;ALLOW ONLY 32 - 255
JB PLGOFC ;FC ERROR IF TOO SMALL
MOV BYTE PTR BEATS,DL ;Store Beats per minute
RET
NCFCER:
PPAUSE: JNB PLGOFC ;ERROR IF NO ARG
XOR CX,CX ;PASS FREQ OF 0
CMP DL,LOW 65D ;ALLOW ONLY 1-64
JNB PLGOFC ;FC ERROR IF TOO BIG
OR DL,DL ;SEE IF ZERO
JZ PLYRET ;RETURN IF SO - NO PAUSE
JMP PPAUS2 ;[DX]=PAUSE LENGTH
POCTAV: JNB PLGOFC ;ERROR IF NO ARG
CMP DL,LOW 7 ;ALLOW ONLY OCTAVES 0..6
JNB PLGOFC ;FC ERROR IF TO BIG
MOV BYTE PTR OCTAVE,DL
PLYRET: RET
PLYNUM: JNB PLGOFC ;ERROR IF NO ARG
MOV AL,DL ;GET NOTE NUMBER INTO [AL]
OR AL,AL ;SEE IF ZERO (PAUSE)
JZ PLYNO3 ;DO THE PAUSE
CMP AL,LOW 85D ;ALLOW ONLY 0..84
JNB PLGOFC ;FC ERROR IF TOO BIG
CBW ;CLEAR HI BYTE FOR DIVIDE
DEC AX ;MAP TO 0..83
MOV DL,LOW 12D ;DIVIDE BY 12
DIV DL
MOV DH,AL ;OCTAVE TO [DH]
MOV AL,AH ;NOTE NUMBER IS REMAINDER
INC AL ;ADD ONE
ADD AL,AL ;DOUBLE TO MAKE INDEX
JMP SHORT PLYNU3 ;PLAY NOTE [AL], OCTAVE [DH]
PLGOFC: JMP FCERR ;GIVE FUNCTION CALL ERROR
PLYNOT: SUB CL,LOW OFFSET "A"-1 ;MAP TO 1..7
ADD CL,CL ;MAP TO 2..14 (THIS ASSUMES SHARP)
CALL FETCHR ;GET NEXT CHARACTER
JZ PLYNO2 ;END OF STRING - NO SHARP OR FLAT
CMP AL,LOW "#" ;CHECK FOR POSSIBLE SHARP
JZ PLYSHP ;SHARP IT THEN
CMP AL,LOW "+" ;"+" ALSO MEANS SHARP
JZ PLYSHP
CMP AL,LOW "-" ;"-" MEANS FLAT
JZ PLYFLT
CALL DECFET ;PUT CHAR BACK IN STRING.
JMP SHORT PLYNO2 ;TREAT AS UNMODIFIED NOTE.
PLYFLT: DEC CL ;DECREMENT TWICE TO FLAT IT
PLYNO2: DEC CL ;MAP BACK TO UNSHARPED
PLYSHP: MOV AL,CL ;INTO [AL] FOR XLAT
MOV BX,OFFSET NOTXLT ;POINT TO TRANSLATE TABLE
?CSLAB: ; Code segment dummy label
XLAT BYTE PTR ?CSLAB ;TRANSLATE INTO NOTE TABLE INDEX
OR AL,AL ;SEE IF LEGAL NOTE
JS PLGOFC ;NOTE'S OK IF NOT .GT. 127
;
; ENTER HERE WITH NOTE TO PLAY IN [AL]
; NOTE 0 IS PAUSE, 2,4,6,8..10,12 ARE A-G AND FRIENDS.
;
PLYNO3:
MOV DH,BYTE PTR OCTAVE ;GET OCTAVE INTO [DH] FOR LATER MATH
PLYNU3:
PUSH AX ;Save Note
PUSH DX ;Save Octave
MOV AL,BYTE PTR NOTELN
MOV BYTE PTR NOTE1L,AL ;One note duration = Note length
CALL FETCHR
JZ PLYNU4 ;Brif end of string
CALL VALSC2 ;See if possible number
CMP DL,LOW 65D ;If was .gt. 64
JNB PLGOFC ; then error
OR DL,DL ;Any Length?
JZ PLYNU4 ;Brif not, just do note
MOV BYTE PTR NOTE1L,DL ;Store duration for this note
PLYNU4:
POP DX ;Get Octave
POP AX ;Restore Note
CBW ;FILL [AH] WITH ZEROS
MOV BX,AX ;TRANSFER TO BX FOR INDEXING
OR BX,BX ;SEE IF PAUSE (NOTE # 0)
JZ PLYNO4 ;IF PAUSE, PASS [BX]=0
MOV BX,WORD PTR NOTTAB-2[BX] ;FETCH FREQUENCY
MOV CL,LOW 6 ;CALCULATE 6-OCTAVE
SUB CL,DH ;FOR # OF TIMES TO SHIFT FREQ.
SHR BX,CL ;DIVIDE BY 2^(6-OCTAVE)
ADC BX,0 ;ADD IN CARRY TO ROUND UP
PLYNO4:
MOV CX,BX ;FREQUENCY INTO [CX] FOR DONOTE
MOV DL,BYTE PTR NOTE1L ;Get this note's length
PPAUS2:
MOV AL,BYTE PTR BEATS ;GET BEATS PER UNIT TIME
MUL DL ;CALC NOTE LENGTH * BEATS
PUSH CX ;SAVE [CX] WHILE WE DIVIDE
MOV CX,AX ;CALC TIME CONST/(BEATS * NOTE LENGTH)
MOV DX,1 ;[DX:AX]=96000 (4*60*400.0) and will
MOV AX,73400O ; cause DONOTE [DX]=1 to play 2.5 milliseconds
DIV CX ; (in other words [DX]=400 will play 1 second)
POP CX ;RESTORE FREQUENCY
OR AX,AX ;IF DURATION IS ZERO, GET OUT.
JZ PLYNO8
PUSH CX ;Save Freq
PLYDOT:
PUSH AX ;Save duration
CALL FETCHR
JZ PLYDOX ;Brif EOS
CMP AL,LOW "." ;Note duration extender?
JNZ PLYDO2 ;Brif not
POP AX ;Get duration
MOV CX,3
MUL CX
SHR AX,1 ;Duration = Duration * 1.5
SHR DX,1 ;Ovf/2
OR DX,DX ;Still too big?
JZ PLYDOT ;Itterate if not
JMP FCERR ; else complain..
PLYDO2:
CALL DECFET ;Put char back
PLYDOX:
POP AX ;Duration
POP CX ;Get freq
OR CX,CX
JZ PLYNO9 ;Brif Pause
CMP BYTE PTR MSCALE,LOW 1
JZ PLYNO9 ;Brif Legatto
PUSH AX ;Save Duration
PUSH CX ;Save Frequency
MOV CL,BYTE PTR MSCALE ;Using scale for shift count
MOV BX,3 ;Stecatto multiplier
CMP CL,LOW 2
JZ PLYNO6 ;Brif Stecatto
MOV BX,7 ; else Normal
PLYNO6:
MUL BX ;Duration * 7/8 or 3/4
SHR AX,CL
OR AX,AX
JNZ PLYNO7 ;If zero
INC AX ; then make 1
PLYNO7:
POP CX ;Get Freq
CALL PLYNO9 ;Send note
POP AX ;Original duration
MOV CL,BYTE PTR MSCALE
SHR AX,CL ;pause after note is 1/8 or 1/4
XOR CX,CX ;Freq = 0 for pause
OR AX,AX ;Pause = 0?
JNZ PLYNO9 ;Brif not
PLYNO8:
RET ; else do nothing
PLYNO9:
MOV DX,AX ;DONOTE wants [CX]=freq, [DX]=duration.
JMP SHORT DOSND ;Play freq [CX] for time [DX]
PLYMER:
JMP FCERR
; PLYMET - Process Music Meta Commands.
PLYMET:
CALL FETCHZ ;Get Meta action or error
MOV CL,LOW 1 ;Factor for Legatto (1/1): MSCALE=1
CMP AL,LOW "L"
JZ PLYDUR ;Brif Legatto (Full note)
INC CL ;Factor for Stecatto (3/4): MSCALE=2
CMP AL,LOW "S"
JZ PLYDUR ;Brif Stecatto (3/4)
INC CL ;Factor for Normal (7/8): MSCALE=3
CMP AL,LOW "N"
JZ PLYDUR ;Brif Normal (7/8)
XOR CL,CL ;MMODE=0 for Forground
CMP AL,LOW "F"
JZ PLYMOD ;Brif Foreground Music
INC CL ;MMODE=1 for Background
CMP AL,LOW "B"
JNZ PLYMER ;Brif not Background Music
PLYMOD:
MOV BYTE PTR MMODE,CL ;Store Music Mode (0=FG, 1=BG)
RET
PLYDUR:
MOV BYTE PTR MSCALE,CL ;Store Duration Scaling factor
RET
;SNDINI is called to set OCTAVE, BEATS, NOTELN, NOTE1L, MSCALE, and MMODE
;to appropriate initial settings. SNDINI is called at CLEARC and during
;initialization.
;Entry - none
;Exit - all registers preserved
;
DSEG SEGMENT PUBLIC 'DATASG'
EXTRN NOTELN:WORD,NOTE1L:WORD,BEATS:WORD,OCTAVE:WORD,MSCALE:WORD
EXTRN MMODE:WORD
DSEG ENDS
PUBLIC SNDINI
SNDINI: MOV BYTE PTR BEATS,LOW 120D
MOV BYTE PTR MSCALE,LOW 3D
MOV BYTE PTR MMODE,LOW 0D
MOV BYTE PTR NOTELN,LOW 4D
MOV BYTE PTR NOTE1L,LOW 4D
MOV BYTE PTR OCTAVE,LOW 4D
CALL SNDRST ;Turn off sound
RET
;SNDRST is called to reset background music. It is called during
; initialization from INIT and during the processing of CTL-C
; from POLKEY
; Entry - none
; Exit - All registers preserved
;
PUBLIC SNDRST
SNDRST: PUSH AX
PUSH BX
PUSH CX
PUSH DX
PUSHF
MOV AL,LOW 255D
CALL DONOTE ;Disable background music, init music queue
POPF
POP DX
POP CX
POP BX
POP AX
RET
PUBLIC BEEPS,BEEP,SOUNDS
EXTRN DONOTE:NEAR,FRQINT:NEAR,FRCSNG:NEAR,GETIN2:NEAR
DSEG SEGMENT PUBLIC 'DATASG'
EXTRN FAC:WORD
DSEG ENDS
BEEP:
BEEPS: MOV CX,800D ; 800 Hz
MOV DX,100D ; .. for 1/4 second.
XOR AL,AL ;[AL]=Music Mode (0=Forground)
JMP SHORT JDNOTE
DOSND: MOV AL,BYTE PTR MMODE ;[AL]=Music Mode (0=Forground, 1=background)
JDNOTE: CALL DONOTE ;start new sound.
JNB DNOTOK ;No errors detected by DONOTE
JMP FCERR ;Function call error detected
DNOTOK:
JMP POLKEY ;Allow CTL-C to interrupt and return
; SOUND - Make SOUNDs with the speaker.
;
; Syntax: SOUND x,y
;
; Where: x is the Frequency in Hertz.
; y is the Duration in Clock ticks. (currently 18.2/sec).
;
; Frequency must be at least 37 Hz.
; If Duration is 0, then just turn off current sound...
;
DSEG SEGMENT PUBLIC 'DATASG'
EXTRN $FACLO:WORD,$FACM1:WORD
DSEG ENDS
EXTRN $FMULS:NEAR
SOUNDS:
CALL GETIN2 ;Get frequency.
CMP DX,37D
JB SNDFCE ;Must be at least 37 Hz..
PUSH DX ;Save frequency
CALL SYNCHR
DB OFFSET ","
CALL FRMEVL ;Get duration.
CALL EOSCHK ;Syntax Error if not end-of-statement
PUSH BX ;Text pointer
CALL FRCSNG ;Make Single Precision
MOV BX,OFFSET FAC ;Point at Exponent
CMP BYTE PTR 0[BX],LOW 0 ;Will turn sound off if 0.
JNZ SOUNL4 ; Brif not, start new sound.
POP BX ;Text pointer
POP DX ;Frequency (not used)
JMP SHORT SNDRST ;Turn off sound, initialize the queue
SOUNL4:
CMP BYTE PTR 0[BX],LOW 221O ;Duration .gt. 65535?
JNB SNDFCE ;Brif so, too big for *32
PUSH BX ;Save FAC address
PUSH WORD PTR $FACM1 ;Push FAC on the stack
PUSH WORD PTR $FACLO
MOV BX,22D ;Mult by ^D22
CALL MAKINT
CALL FRCSNG ;Get s.p. ^D22
POP DX ;Get low mantissa bits
POP BX ;Exp sign and high mantissa bits
CALL $FMULS ;MULTIPLY
POP BX ;FAC address
CMP BYTE PTR 0[BX],LOW 221O ;Overflow?
JB SOUNL5 ;Brif not
MOV WORD PTR -1[BX],110177O ; else
MOV WORD PTR -3[BX],177400O ; force to 65535
SOUNL5:
CALL FRQINT ;Convert back to Integer
MOV DX,BX ; in [DX]
POP BX ;Text pointer
POP CX ;[CX]=Frequency, [DX]=Duration
JMP SHORT DOSND ;play the note
SNDFCE:
JMP FCERR ; Complain
PAGE
SUBTTL General Event Trapping Code
PUBLIC ONGOTP,SETGSB
EXTRN STPTRP:NEAR,ONTRP:NEAR,OFFTRP:NEAR,REQTRP:NEAR,FRETRP:NEAR
DSEG SEGMENT PUBLIC 'DATASG'
EXTRN $ON:WORD,$OFF:WORD,$STOP:WORD
DSEG ENDS
DSEG SEGMENT PUBLIC 'DATASG'
EXTRN TRPTBL:WORD
DSEG ENDS
;Event flags can have one or more of the following bits set:
; They are defined in BIMISC.MAC
;
DSEG SEGMENT PUBLIC 'DATASG'
EXTRN T_ON:WORD ;1 event trapping on
DSEG ENDS
DSEG SEGMENT PUBLIC 'DATASG'
EXTRN T_STOP:WORD ;2 event trapping stopped (remembers but doesn't report)
DSEG ENDS
DSEG SEGMENT PUBLIC 'DATASG'
EXTRN T_REQ:WORD ;4 event trap requested (this event has happend)
DSEG ENDS
;To support EVENT TRAPPING, The following switches should be defined
; in the machine dependant Switch File:
;
; NMKEYT = number of soft keys
; NMCOMT = number of COMmunications ports
; NMPENT = number of light pens (0 or 1)
; NMSTRT = number of joysticks
; NUMTRP = total of all of the above
; ONGOSB should be 1
;
;To support EVENT TRAPPING, The following variables should be defined
; in the machine dependant RAM module:
;
; ONGSBF: BLOCK 1 ;some-event happend flag (see NEWSTT)
; TRPTBL: BLOCK 3*NUMTRP
; ;event flags and GOSUB line ptrs
;
PENOFF=0 ;offset for PEN event id's
KEYOFF=PENOFF+NMPENT ;offset for KEY event id's
COMOFF=KEYOFF+NMKEYT ;offset for COM event id's
STROFF=COMOFF+NMCOMT ;offset for STRIG event id's
PUBLIC CHKINT
EXTRN POLKEY:NEAR,POLLEV:NEAR
DSEG SEGMENT PUBLIC 'DATASG'
EXTRN AUTFLG:WORD,SEMFLG:WORD,SAVTXT:WORD,SAVSTK:WORD,CURLIN:WORD
DSEG ENDS
;CHKINT is called from BASIC's NEWSTT loop to see if any trappable
; condition has occured. It traps active function keys, COM input,
; light pen interrupts, joystick triggers, CTL-C, CTL-S, and
; it queues vanilla keys for CHSNS. For efficiency, it calls POLLEV
; which looks at flag which gets set by BIOS when some interrupt occurs.
; This routine would not be necessary in a stand-alone environment since
; BASIC would manage its own interrupts.
;
CHKINT:
DSEG SEGMENT PUBLIC 'DATASG'
EXTRN MSDCCF:WORD ;MSDOS Ctl-C flag
DSEG ENDS
TEST BYTE PTR MSDCCF,LOW 255D ;Test for MSDOS-received Ctl-C