~amaurycarvalho/msxbas2asm/trunk

BASIC_DEFTBL: equ 0xF6CA ; 26 table of variables defined by DEFINT, DEFSTR, DEFSNG and DEFDBL for each alphabet letter (2 = integer, 3 = String, 4 = Simple precision, 8 = Double precision).

385

386

BASIC_CURLIN: equ 0xF41C ; BASIC current line number

387

BASIC_INTVAL: equ 0xFCA0 ; interval value

388

BASIC_INTCNT: equ 0xFCA2 ; interval current count

389

390

BASIC_PRMPRV: equ 0xF74C ; Pointer to previous parameter block in PARM1

391

392

BASIC_TRPTBL: equ 0xFC4C ; 78 trap table - array of 3 bytes - state[1] (bit 0=on, bit 1=stop, bit 2=active) + address[2]

393

394

BASIC_TRPTBL_KEY: equ 0xFC4C ; 30 ON KEY GOSUB

395

BASIC_TRPTBL_STOP: equ 0xFC6A ; 3 ON STOP GOSUB

396

BASIC_TRPTBL_SPRITE: equ 0xFC6D ; 3 ON SPRITE GOSUB

397

BASIC_TRPTBL_STRIG: equ 0xFC70 ; 15 ON STRIG GOSUB

398

BASIC_TRPTBL_INTERVAL: equ 0xFC7F ; 3 ON INTERVAL GOSUB

399

BASIC_TRPTBL_OTHER: equ 0xFC82 ; 24 reserved for expansion

400

401

BASIC_ONGSBF: equ 0xFBD8 ; 1 trap occurred counter (0=not occurred)

402

403

404

405

;--------------------------------------------------------

406

; MATH PACK ROUTINES

407

;--------------------------------------------------------

408

409

;--------------------------------------------------------

410

; SUPPORT MACROS

411

;--------------------------------------------------------

412

COMPILE_TO_ROM: EQU 1

413

414

MACRO __call_basic,CALL_PARM

415

;ld iy,(BIOS_EXPTBL-1)

416

;ld ix, CALL_PARM

417

;call BIOS_CALSLT

418

419

ld ix, CALL_PARM

420

call BIOS_CALBAS

421

422

;ld ix, CALL_PARM

423

;ld iy, (BIOS_SLTROM+1)

424

;call BIOS_CALSLT

425

426

;call CALL_PARM

427

428

;ld ix, CALL_PARM

429

;call CALL_BIOS

430

431

ENDM

432

433

if defined COMPILE_TO_DOS

434

435

MACRO __call_bios,CALL_PARM

436

;ld iy,(BIOS_EXPTBL-1)

437

ld ix, CALL_PARM

438

call BIOS_CALBAS ; BIOS_CALSLT

439

ENDM

440

441

else

442

443

MACRO __call_bios,CALL_PARM

444

;ld iy,(BIOS_EXPTBL-1)

445

;ld ix, CALL_PARM

446

;call BIOS_CALSLT

447

448

;ld ix, CALL_PARM

449

;call BIOS_CALBAS

450

451

;ld ix, CALL_PARM

452

;ld iy, (BIOS_SLTROM+1)

453

;call BIOS_CALSLT

454

455

call CALL_PARM

456

457

;ld ix, CALL_PARM

458

;call CALL_BIOS

459

ENDM

460

461

endif

462

463

MACRO push.parm

464

push hl ; save parameter

465

ENDM

466

467

MACRO pop.parm

468

pop iy ; restore PC of caller

469

pop hl ; get next parameter

470

push iy ; save PC of caller

471

ENDM

472

473

MACRO push.ret.parm

474

pop iy ; restore PC of caller

475

push hl ; save return parameter

476

push iy ; save PC of caller

477

ENDM

478

479

MACRO ret.parm

480

pop iy ; restore PC of caller

481

push hl ; save return parameter

482

push iy ; save PC of caller

483

ret ; return

484

ENDM

485

486

MACRO set.line.number, line_number

487

ld bc, line_number ; current line number

488

ld (BASIC_CURLIN), bc

489

ENDM

490

491

MACRO verify.break

492

ld a, (BIOS_INTFLG) ; verify CTRL+BREAK

493

or a

494

jp nz, end_pgm

495

ENDM

496

497

MACRO check.traps

498

ld a, (BASIC_ONGSBF) ; trap occured counter

499

or a

500

call nz, RUN_TRAPS

501

ENDM

502

503

504

;---------------------------------------------------------------------------------------------------------

505

; PROGRAM HEADER

506

;---------------------------------------------------------------------------------------------------------

507

508

pageSize: equ 0x4000 ; 8k

509

510

if defined COMPILE_TO_BIN

511

512

pgmArea: equ 0x8000 ; page 2 - program area

513

ramArea: equ 0xc000 ; page 3 - free RAM start area

514

515

org pgmArea ; program binary type start address

516

db 0FEh ; binary file ID

517

dw start_pgm ; begin address

518

dw end_file - 1 ; end address

519

dw start_pgm ; program execution address (for ,R option)

520

521

else

522

if defined COMPILE_TO_ROM

523

524

pgmArea: equ 0x4000 ; page 1 and 2 - program area

525

ramArea: equ 0xc000 ; page 3 - free RAM start area

526

527

org pgmArea ; program rom type start address

528

db 'AB' ; rom file ID

529

dw start_pgm ; INIT

530

dw 0x0000 ; STATEMENT

531

dw 0x0000 ; DEVICE

532

dw 0x0000 ; TEXT

533

ds 6,0 ; RESERVED

534

535

else

536

537

pgmArea: equ 0x8000 ; page 2 - program area

538

ramArea: equ 0xc000 ; page 3 - free RAM start area

539

540

org pgmArea ; program DOS type start address ; 0x0100

541

542

endif

543

endif

544

545

546

PROGRAM_SLOT_2_ENABLE:

547

call BIOS_RSLREG

548

call PROGRAM_SLOT_ENABLE_SUB

549

ld h,080h

550

jp BIOS_ENASLT ; Select the ROM on page 8000h-BFFFh

551

552

PROGRAM_SLOT_1_ENABLE:

553

call BIOS_RSLREG

554

rrca

555

rrca

556

call PROGRAM_SLOT_ENABLE_SUB

557

ld h,040h

558

jp BIOS_ENASLT ; Select the ROM on page 4000h-7FFFh

559

560

PROGRAM_SLOT_ENABLE_SUB:

561

rrca

562

rrca

563

and 3 ;Keep bits corresponding to the page

564

ld c,a

565

ld b,0

566

ld hl,BIOS_EXPTBL

567

add hl,bc

568

ld a,(hl)

569

and 80h

570

or c

571

ld c,a

572

inc hl

573

inc hl

574

inc hl

575

inc hl

576

ld a,(hl)

577

and 0Ch

578

or c

579

ret

580

581

582

;---------------------------------------------------------------------------------------------------------

583

; PROGRAM MAIN CODE

584

;---------------------------------------------------------------------------------------------------------

585

586

start_pgm: ; start of the program

587

588

;call BIOS_BASIC_SLOT_ENABLE ; enable bios and basic on page 0 and 1

589

590

call PROGRAM_SLOT_2_ENABLE

591

592

__call_bios BIOS_ERAFNK ; turn off function keys display

593

__call_bios BIOS_GICINI ; initialize sound system

594

__call_bios BIOS_INITXT ; initialize text screen

595

xor a

596

ld (BIOS_CLIKSW), a ; disable keyboard click

597

ld bc, 0xFFFF ;

598

ld (BASIC_CURLIN), bc ; interpreter in direct mode

599

__call_basic BASIC_TRAP_CLEAR ; clear traps work space

600

;call INITIALIZE_PARAMETERS ; initialize parameters stack

601

call memory.init ; initialize memory allocation

602

call INITIALIZE_VARIABLES ; initialize variables

603

604

605

606

TAG_10:

607

check.traps ; check traps

608

609

TAG_20:

610

check.traps ; check traps

611

612

TAG_25:

613

check.traps ; check traps

614

615

TAG_30:

616

check.traps ; check traps

617

618

TAG_40:

619

check.traps ; check traps

620

621

TAG_50:

622

check.traps ; check traps

623

call INTERVAL_OFF ; action call

624

call SPRITE_OFF ; action call

625

ld hl, LIT_6 ; parameter

626

push.parm

627

call SCREEN ; action call

628

ld hl, LIT_13 ; parameter

629

push.parm

630

call COLOR_BORDER ; action call

631

ld hl, LIT_11 ; parameter

632

push.parm

633

call COLOR_BACKGROUND ; action call

634

ld hl, LIT_9 ; parameter

635

push.parm

636

call COLOR_FOREGROUND ; action call

637

call COLOR ; action call

638

ld hl, LIT_15 ; parameter

639

push.parm

640

ld hl, IDF_14 ; parameter

641

push.parm

642

call LET ; action call

643

ld hl, LIT_17 ; parameter

644

push.parm

645

ld hl, IDF_16 ; parameter

646

push.parm

647

call LET ; action call

648

649

TAG_51:

650

check.traps ; check traps

651

ld hl, LIT_19 ; parameter

652

push.parm

653

ld hl, IDF_18 ; parameter

654

push.parm

655

call LET ; action call

656

ld hl, LIT_21 ; parameter

657

push.parm

658

ld hl, IDF_20 ; parameter

659

push.parm

660

call LET ; action call

661

ld hl, LIT_23 ; parameter

662

push.parm

663

ld hl, IDF_22 ; parameter

664

push.parm

665

call LET ; action call

666

ld hl, LIT_25 ; parameter

667

push.parm

668

ld hl, IDF_24 ; parameter

669

push.parm

670

call LET ; action call

671

672

TAG_55:

673

check.traps ; check traps

674

ld hl, LIT_27 ; parameter

675

push.parm

676

ld hl, IDF_26 ; parameter

677

push.parm

678

call LET ; action call

679

call CLS ; action call

680

681

TAG_60:

682

check.traps ; check traps

683

ld hl, LIT_31 ; parameter

684

push.parm

685

ld hl, LIT_30 ; parameter

686

push.parm

687

call LOCATE ; action call

688

ld hl, LIT_33 ; parameter

689

push.parm

690

call PRINT ; action call

691

ld hl, PRINT.CRLF ; parameter

692

push.parm

693

call PRINT ; action call

694

695

TAG_61:

696

check.traps ; check traps

697

ld hl, LIT_35 ; parameter

698

push.parm

699

ld hl, LIT_34 ; parameter

700

push.parm

701

call LOCATE ; action call

702

ld hl, LIT_36 ; parameter

703

push.parm

704

call PRINT ; action call

705

ld hl, PRINT.CRLF ; parameter

706

push.parm

707

call PRINT ; action call

708

709

TAG_62:

710

check.traps ; check traps

711

ld hl, LIT_38 ; parameter

712

push.parm

713

ld hl, LIT_37 ; parameter

714

push.parm

715

call LOCATE ; action call

716

ld hl, LIT_39 ; parameter

717

push.parm

718

call PRINT ; action call

719

ld hl, PRINT.CRLF ; parameter

720

push.parm

721

call PRINT ; action call

722

723

TAG_65:

724

check.traps ; check traps

725

;ld hl, IDF_26 ; parameter

726

;push.parm

727

;call SET_PLAY_VOICE_1 ; action call

728

;call DO_PLAY ; action call

729

730

TAG_70:

731

check.traps ; check traps

732

ld hl, LIT_45 ; parameter

733

push.parm

734

call STRIG ; action call

735

ld hl, LIT_46 ; parameter

736

push.parm

737

call STRIG ; action call

738

call BOOLEAN.OR ; action call

739

ld hl, IDF_42 ; parameter

740

push.parm

741

call LET ; action call

742

IF_1 : ; start of IF command

743

ld hl, IDF_42 ; parameter

744

push.parm

745

call BOOLEAN.IF ; verify IF condition result, out in A

746

or a ; cp 0 = false

747

jp z, ELSE_1 ; if false, jump to ELSE actions

748

THEN_1 : ; THEN actions

749

call CLS ; action call

750

jp TAG_90 ; go to

751

jp ENDIF_1 ; jump to END of IF command

752

ELSE_1 : ; ELSE actions

753

ENDIF_1 : ; end of IF command

754

755

TAG_80:

756

check.traps ; check traps

757

IF_2 : ; start of IF command

758

ld hl, LIT_53 ; parameter

759

push.parm

760

call PLAY ; action call

761

call BOOLEAN.IF ; verify IF condition result, out in A

762

or a ; cp 0 = false

763

jp z, ELSE_2 ; if false, jump to ELSE actions

764

THEN_2 : ; THEN actions

765

jp TAG_70 ; go to

766

jp ENDIF_2 ; jump to END of IF command

767

ELSE_2 : ; ELSE actions

768

jp TAG_65 ; go to

769

ENDIF_2 : ; end of IF command

770

771

TAG_90:

772

check.traps ; check traps

773

call BEEP ; action call

774

ld hl, LIT_58 ; parameter

775

push.parm

776

call SCREEN ; action call

777

ld hl, LIT_60 ; parameter

778

push.parm

779

call SPRITEMODE ; action call

780

call RESTORE ; action call

781

782

TAG_91:

783

check.traps ; check traps

784

call TAG_300 ; gosub

785

786

TAG_92:

787

check.traps ; check traps

788

ld hl, LIT_65 ; parameter

789

push.parm

790

call ON_SPRITE ; action call

791

792

TAG_93:

793

check.traps ; check traps

794

ld hl, LIT_68 ; parameter

795

push.parm

796

ld hl, LIT_67 ; parameter

797

push.parm

798

call ON_INTERVAL ; action call

799

800

TAG_94:

801

check.traps ; check traps

802

FOR_1 : ; start of FOR command

803

ld hl, LIT_72 ; parameter

804

push.parm

805

ld hl, IDF_71 ; parameter

806

push.parm

807

call LET ; action call

808

jp FOR.WHILE_1 ; jump to test if end of FOR

809

FOR.STEP_1 : ; STEP action

810

ld hl, LIT_75 ; parameter

811

push.parm

812

ld hl, IDF_71 ; parameter

813

push.parm

814

call MATH.ADD ; action call

815

ld hl, IDF_71 ; parameter

816

push.parm

817

call LET ; action call

818

FOR.WHILE_1 : ; test if end of FOR

819

ld hl, IDF_71 ; parameter

820

push.parm

821

ld hl, LIT_78 ; parameter

822

push.parm

823

call BOOLEAN.LE ; action call

824

call BOOLEAN.IF ; verify IF condition result, out in A

825

or a ; cp 0 = false

826

jp z, ENDFOR_1 ; end the loop if while condition is false

827

FOR.BODY_1 : ; start of FOR user code

828

ld hl, LIT_81 ; parameter

829

push.parm

830

call RND ; action call

831

ld hl, LIT_82 ; parameter

832

push.parm

833

call MATH.MULT ; action call

834

call INT ; action call

835

ld hl, IDF_42 ; parameter

836

push.parm

837

call LET ; action call

838

ld hl, IDF_42 ; parameter

839

push.parm

840

call PSET.COLOR ; action call

841

ld hl, LIT_88 ; parameter

842

push.parm

843

call RND ; action call

844

ld hl, LIT_89 ; parameter

845

push.parm

846

call MATH.MULT ; action call

847

call INT ; action call

848

ld hl, LIT_86 ; parameter

849

push.parm

850

call RND ; action call

851

ld hl, LIT_87 ; parameter

852

push.parm

853

call MATH.MULT ; action call

854

call INT ; action call

855

call PSET.XY ; action call

856

call PSET ; action call

857

jp FOR.STEP_1 ; repeat actions

858

ENDFOR_1 : ; END of FOR command

859

860

TAG_95:

861

check.traps ; check traps

862

call TAG_190 ; gosub

863

ld hl, LIT_95 ; parameter

864

push.parm

865

call COLOR_BORDER ; action call

866

ld hl, LIT_94 ; parameter

867

push.parm

868

call COLOR_BACKGROUND ; action call

869

ld hl, LIT_93 ; parameter

870

push.parm

871

call COLOR_FOREGROUND ; action call

872

call COLOR ; action call

873

call INTERVAL_ON ; action call

874

call SPRITE_ON ; action call

875

876

TAG_100:

877

check.traps ; check traps

878

ld hl, LIT_99 ; parameter

879

push.parm

880

call STICK ; action call

881

ld hl, LIT_100 ; parameter

882

push.parm

883

call STICK ; action call

884

call BOOLEAN.OR ; action call

885

ld hl, IDF_42 ; parameter

886

push.parm

887

call LET ; action call

888

889

TAG_110:

890

check.traps ; check traps

891

IF_3 : ; start of IF command

892

ld hl, IDF_42 ; parameter

893

push.parm

894

ld hl, LIT_101 ; parameter

895

push.parm

896

call BOOLEAN.EQ ; action call

897

ld hl, IDF_18 ; parameter

898

push.parm

899

ld hl, LIT_103 ; parameter

900

push.parm

901

call BOOLEAN.LT ; action call

902

call BOOLEAN.AND ; action call

903

call BOOLEAN.IF ; verify IF condition result, out in A

904

or a ; cp 0 = false

905

jp z, ELSE_3 ; if false, jump to ELSE actions

906

THEN_3 : ; THEN actions

907

ld hl, IDF_18 ; parameter

908

push.parm

909

ld hl, LIT_106 ; parameter

910

push.parm

911

call MATH.ADD ; action call

912

ld hl, IDF_18 ; parameter

913

push.parm

914

call LET ; action call

915

jp ENDIF_3 ; jump to END of IF command

916

ELSE_3 : ; ELSE actions

917

ENDIF_3 : ; end of IF command

918

919

TAG_120:

920

check.traps ; check traps

921

IF_4 : ; start of IF command

922

ld hl, IDF_42 ; parameter

923

push.parm

924

ld hl, LIT_107 ; parameter

925

push.parm

926

call BOOLEAN.EQ ; action call

927

ld hl, IDF_18 ; parameter

928

push.parm

929

ld hl, LIT_108 ; parameter

930

push.parm

931

call BOOLEAN.GT ; action call

932

call BOOLEAN.AND ; action call

933

call BOOLEAN.IF ; verify IF condition result, out in A

934

or a ; cp 0 = false

935

jp z, ELSE_4 ; if false, jump to ELSE actions

936

THEN_4 : ; THEN actions

937

ld hl, IDF_18 ; parameter

938

push.parm

939

ld hl, LIT_110 ; parameter

940

push.parm

941

call MATH.SUB ; action call

942

ld hl, IDF_18 ; parameter

943

push.parm

944

call LET ; action call

945

jp ENDIF_4 ; jump to END of IF command

946

ELSE_4 : ; ELSE actions

947

ENDIF_4 : ; end of IF command

948

949

TAG_130:

950

check.traps ; check traps

951

ld hl, LIT_114 ; parameter

952

push.parm

953

ld hl, IDF_20 ; parameter

954

push.parm

955

ld hl, IDF_18 ; parameter

956

push.parm

957

ld hl, LIT_113 ; parameter

958

push.parm

959

call PUT_SPRITE_COLOR ; action call

960

961

TAG_140:

962

check.traps ; check traps

963

IF_5 : ; start of IF command

964

ld hl, IDF_16 ; parameter

965

push.parm

966

ld hl, LIT_115 ; parameter

967

push.parm

968

call BOOLEAN.EQ ; action call

969

call BOOLEAN.IF ; verify IF condition result, out in A

970

or a ; cp 0 = false

971

jp z, ELSE_5 ; if false, jump to ELSE actions

972

THEN_5 : ; THEN actions

973

jp TAG_210 ; go to

974

jp ENDIF_5 ; jump to END of IF command

975

ELSE_5 : ; ELSE actions

976

ENDIF_5 : ; end of IF command

977

978

TAG_150:

979

check.traps ; check traps

980

ld hl, LIT_119 ; parameter

981

push.parm

982

ld hl, IDF_22 ; parameter

983

push.parm

984

ld hl, IDF_118 ; parameter

985

push.parm

986

ld hl, LIT_117 ; parameter

987

push.parm

988

call PUT_SPRITE_COLOR ; action call

989

990

TAG_160:

991

check.traps ; check traps

992

ld hl, LIT_120 ; parameter

993

push.parm

994

call STRIG ; action call

995

ld hl, LIT_121 ; parameter

996

push.parm

997

call STRIG ; action call

998

call BOOLEAN.OR ; action call

999

ld hl, IDF_42 ; parameter

1000

push.parm

1001

call LET ; action call

1002

IF_6 : ; start of IF command

1003

ld hl, IDF_42 ; parameter

1004

push.parm

1005

call BOOLEAN.IF ; verify IF condition result, out in A

1006

or a ; cp 0 = false

1007

jp z, ELSE_6 ; if false, jump to ELSE actions

1008

THEN_6 : ; THEN actions

1009

jp TAG_50 ; go to

1010

jp ENDIF_6 ; jump to END of IF command

1011

ELSE_6 : ; ELSE actions

1012

ENDIF_6 : ; end of IF command

1013

1014

TAG_170:

1015

check.traps ; check traps

1016

jp TAG_100 ; go to

1017

1018

TAG_180:

1019

check.traps ; check traps

1020

call SPRITE_OFF ; action call

1021

ld hl, LIT_126 ; parameter

1022

push.parm

1023

ld hl, LIT_125 ; parameter

1024

push.parm

1025

ld hl, IDF_118 ; parameter

1026

push.parm

1027

ld hl, LIT_124 ; parameter

1028

push.parm

1029

call PUT_SPRITE_COLOR ; action call

1030

ld hl, LIT_127 ; parameter

1031

push.parm

1032

call COLOR_BORDER ; action call

1033

call COLOR ; action call

1034

;ld hl, LIT_128 ; parameter

1035

;push.parm

1036

;call SET_PLAY_VOICE_1 ; action call

1037

;call DO_PLAY ; action call

1038

1039

TAG_181:

1040

check.traps ; check traps

1041

ld hl, IDF_14 ; parameter

1042

push.parm

1043

ld hl, LIT_129 ; parameter

1044

push.parm

1045

call MATH.ADD ; action call

1046

ld hl, IDF_14 ; parameter

1047

push.parm

1048

call LET ; action call

1049

ld hl, LIT_130 ; parameter

1050

push.parm

1051

call COLOR_BORDER ; action call

1052

call COLOR ; action call

1053

call TAG_190 ; gosub

1054

call SPRITE_ON ; action call

1055

ret ; return/gosub

1056

1057

TAG_185:

1058

check.traps ; check traps

1059

call SPRITE_OFF ; action call

1060

ld hl, LIT_134 ; parameter

1061

push.parm

1062

ld hl, IDF_22 ; parameter

1063

push.parm

1064

ld hl, IDF_118 ; parameter

1065

push.parm

1066

ld hl, LIT_133 ; parameter

1067

push.parm

1068

call PUT_SPRITE_COLOR ; action call

1069

;ld hl, LIT_135 ; parameter

1070

;push.parm

1071

;call SET_PLAY_VOICE_1 ; action call

1072

;call DO_PLAY ; action call

1073

ld hl, IDF_16 ; parameter

1074

push.parm

1075

ld hl, LIT_136 ; parameter

1076

push.parm

1077

call MATH.SUB ; action call

1078

ld hl, IDF_16 ; parameter

1079

push.parm

1080

call LET ; action call

1081

1082

TAG_186:

1083

check.traps ; check traps

1084

ld hl, LIT_140 ; parameter

1085

push.parm

1086

ld hl, LIT_138 ; parameter

1087

push.parm

1088

call MATH.NEG ; action call

1089

ld hl, IDF_118 ; parameter

1090

push.parm

1091

ld hl, LIT_137 ; parameter

1092

push.parm

1093

call PUT_SPRITE_COLOR ; action call

1094

call SPRITE_ON ; action call

1095

1096

TAG_190:

1097

check.traps ; check traps

1098

ld hl, LIT_141 ; parameter

1099

push.parm

1100

ld hl, IDF_22 ; parameter

1101

push.parm

1102

call LET ; action call

1103

ld hl, LIT_142 ; parameter

1104

push.parm

1105

call RND ; action call

1106

ld hl, LIT_143 ; parameter

1107

push.parm

1108

call MATH.MULT ; action call

1109

ld hl, LIT_144 ; parameter

1110

push.parm

1111

call MATH.ADD ; action call

1112

call INT ; action call

1113

ld hl, IDF_118 ; parameter

1114

push.parm

1115

call LET ; action call

1116

IF_7 : ; start of IF command

1117

ld hl, IDF_118 ; parameter

1118

push.parm

1119

ld hl, LIT_145 ; parameter

1120

push.parm

1121

call MATH.MOD ; action call

1122

ld hl, LIT_147 ; parameter

1123

push.parm

1124

call BOOLEAN.EQ ; action call

1125

call BOOLEAN.IF ; verify IF condition result, out in A

1126

or a ; cp 0 = false

1127

jp z, ELSE_7 ; if false, jump to ELSE actions

1128

THEN_7 : ; THEN actions

1129

ld hl, LIT_148 ; parameter

1130

push.parm

1131

ld hl, IDF_24 ; parameter

1132

push.parm

1133

call LET ; action call

1134

jp ENDIF_7 ; jump to END of IF command

1135

ELSE_7 : ; ELSE actions

1136

ld hl, LIT_149 ; parameter

1137

push.parm

1138

ld hl, IDF_24 ; parameter

1139

push.parm

1140

call LET ; action call

1141

ENDIF_7 : ; end of IF command

1142

1143

TAG_200:

1144

check.traps ; check traps

1145

ld hl, LIT_155 ; parameter

1146

push.parm

1147

call PSET.COLOR ; action call

1148

ld hl, LIT_154 ; parameter

1149

push.parm

1150

ld hl, LIT_153 ; parameter

1151

push.parm

1152

ld hl, LIT_152 ; parameter

1153

push.parm

1154

ld hl, LIT_151 ; parameter

1155

push.parm

1156

call PSET.XY ; action call

1157

call FBOX ; action call

1158

1159

TAG_205:

1160

check.traps ; check traps

1161

ld hl, LIT_156 ; parameter

1162

push.parm

1163

call COLOR_FOREGROUND ; action call

1164

call COLOR ; action call

1165

ld hl, LIT_158 ; parameter

1166

push.parm

1167

ld hl, LIT_157 ; parameter

1168

push.parm

1169

call LOCATE ; action call

1170

ld hl, LIT_159 ; parameter

1171

push.parm

1172

call PRINT ; action call

1173

ld hl, IDF_14 ; parameter

1174

push.parm

1175

call PRINT ; action call

1176

ld hl, LIT_160 ; parameter

1177

push.parm

1178

call PRINT ; action call

1179

ld hl, IDF_16 ; parameter

1180

push.parm

1181

call PRINT ; action call

1182

ld hl, PRINT.CRLF ; parameter

1183

push.parm

1184

call PRINT ; action call

1185

ret ; return/gosub

1186

1187

TAG_210:

1188

check.traps ; check traps

1189

call INTERVAL_OFF ; action call

1190

call SPRITE_OFF ; action call

1191

ld hl, LIT_161 ; parameter

1192

push.parm

1193

call SCREEN ; action call

1194

ld hl, LIT_163 ; parameter

1195

push.parm

1196

ld hl, LIT_162 ; parameter

1197

push.parm

1198

call LOCATE ; action call

1199

ld hl, LIT_164 ; parameter

1200

push.parm

1201

call PRINT ; action call

1202

ld hl, PRINT.CRLF ; parameter

1203

push.parm

1204

call PRINT ; action call

1205

1206

TAG_215:

1207

check.traps ; check traps

1208

;ld hl, LIT_165 ; parameter

1209

;push.parm

1210

;call SET_PLAY_VOICE_1 ; action call

1211

;call DO_PLAY ; action call

1212

1213

TAG_220:

1214

check.traps ; check traps

1215

IF_8 : ; start of IF command

1216

ld hl, LIT_166 ; parameter

1217

push.parm

1218

call PLAY ; action call

1219

call BOOLEAN.IF ; verify IF condition result, out in A

1220

or a ; cp 0 = false

1221

jp z, ELSE_8 ; if false, jump to ELSE actions

1222

THEN_8 : ; THEN actions

1223

jp TAG_220 ; go to

1224

jp ENDIF_8 ; jump to END of IF command

1225

ELSE_8 : ; ELSE actions

1226

call CLS ; action call

1227

jp TAG_50 ; go to

1228

ENDIF_8 : ; end of IF command

1229

1230

TAG_230:

1231

check.traps ; check traps

1232

IF_9 : ; start of IF command

1233

ld hl, IDF_22 ; parameter

1234

push.parm

1235

ld hl, LIT_169 ; parameter

1236

push.parm

1237

call BOOLEAN.LT ; action call

1238

call BOOLEAN.IF ; verify IF condition result, out in A

1239

or a ; cp 0 = false

1240

jp z, ELSE_9 ; if false, jump to ELSE actions

1241

THEN_9 : ; THEN actions

1242

ld hl, IDF_22 ; parameter

1243

push.parm

1244

ld hl, IDF_24 ; parameter

1245

push.parm

1246

call MATH.ADD ; action call

1247

ld hl, IDF_22 ; parameter

1248

push.parm

1249

call LET ; action call

1250

jp ENDIF_9 ; jump to END of IF command

1251

ELSE_9 : ; ELSE actions

1252

call TAG_185 ; gosub

1253

ENDIF_9 : ; end of IF command

1254

1255

TAG_235:

1256

check.traps ; check traps

1257

ret ; return/gosub

1258

1259

TAG_300:

1260

check.traps ; check traps

1261

ld hl, LIT_172 ; parameter

1262

push.parm

1263

ld hl, IDF_171 ; parameter

1264

push.parm

1265

call LET ; action call

1266

FOR_2 : ; start of FOR command

1267

ld hl, LIT_173 ; parameter

1268

push.parm

1269

ld hl, IDF_71 ; parameter

1270

push.parm

1271

call LET ; action call

1272

jp FOR.WHILE_2 ; jump to test if end of FOR

1273

FOR.STEP_2 : ; STEP action

1274

ld hl, LIT_174 ; parameter

1275

push.parm

1276

ld hl, IDF_71 ; parameter

1277

push.parm

1278

call MATH.ADD ; action call

1279

ld hl, IDF_71 ; parameter

1280

push.parm

1281

call LET ; action call

1282

FOR.WHILE_2 : ; test if end of FOR

1283

ld hl, IDF_71 ; parameter

1284

push.parm

1285

ld hl, LIT_175 ; parameter

1286

push.parm

1287

call BOOLEAN.LE ; action call

1288

call BOOLEAN.IF ; verify IF condition result, out in A

1289

or a ; cp 0 = false

1290

jp z, ENDFOR_2 ; end the loop if while condition is false

1291

FOR.BODY_2 : ; start of FOR user code

1292

ld hl, IDF_177 ; parameter

1293

push.parm

1294

call READ ; action call

1295

ld hl, IDF_171 ; parameter

1296

push.parm

1297

ld hl, IDF_177 ; parameter

1298

push.parm

1299

call CHR ; action call

1300

call MATH.ADD ; action call

1301

ld hl, IDF_171 ; parameter

1302

push.parm

1303

call LET ; action call

1304

jp FOR.STEP_2 ; repeat actions

1305

ENDFOR_2 : ; END of FOR command

1306

1307

TAG_310:

1308

check.traps ; check traps

1309

ld hl, LIT_180 ; parameter

1310

push.parm

1311

ld hl, IDF_179 ; parameter

1312

push.parm

1313

call LET ; action call

1314

FOR_3 : ; start of FOR command

1315

ld hl, LIT_181 ; parameter

1316

push.parm

1317

ld hl, IDF_71 ; parameter

1318

push.parm

1319

call LET ; action call

1320

jp FOR.WHILE_3 ; jump to test if end of FOR

1321

FOR.STEP_3 : ; STEP action

1322

ld hl, LIT_182 ; parameter

1323

push.parm

1324

ld hl, IDF_71 ; parameter

1325

push.parm

1326

call MATH.ADD ; action call

1327

ld hl, IDF_71 ; parameter

1328

push.parm

1329

call LET ; action call

1330

FOR.WHILE_3 : ; test if end of FOR

1331

ld hl, IDF_71 ; parameter

1332

push.parm

1333

ld hl, LIT_183 ; parameter

1334

push.parm

1335

call BOOLEAN.LE ; action call

1336

call BOOLEAN.IF ; verify IF condition result, out in A

1337

or a ; cp 0 = false

1338

jp z, ENDFOR_3 ; end the loop if while condition is false

1339

FOR.BODY_3 : ; start of FOR user code

1340

ld hl, IDF_177 ; parameter

1341

push.parm

1342

call READ ; action call

1343

ld hl, IDF_179 ; parameter

1344

push.parm

1345

ld hl, IDF_177 ; parameter

1346

push.parm

1347

call CHR ; action call

1348

call MATH.ADD ; action call

1349

ld hl, IDF_179 ; parameter

1350

push.parm

1351

call LET ; action call

1352

jp FOR.STEP_3 ; repeat actions

1353

ENDFOR_3 : ; END of FOR command

1354

1355

TAG_320:

1356

check.traps ; check traps

1357

ld hl, IDF_171 ; parameter

1358

push.parm

1359

ld hl, LIT_185 ; parameter

1360

push.parm

1361

call SPRITE ; action call

1362

ld hl, IDF_179 ; parameter

1363

push.parm

1364

ld hl, LIT_186 ; parameter

1365

push.parm

1366

call SPRITE ; action call

1367

1368

TAG_390:

1369

check.traps ; check traps

1370

ret ; return/gosub

1371

1372

TAG_399:

1373

check.traps ; check traps

1374

1375

TAG_400:

1376

check.traps ; check traps

1377

1378

TAG_410:

1379

check.traps ; check traps

1380

1381

TAG_420:

1382

check.traps ; check traps

1383

1384

TAG_430:

1385

check.traps ; check traps

1386

1387

TAG_440:

1388

check.traps ; check traps

1389

1390

TAG_450:

1391

check.traps ; check traps

1392

1393

TAG_460:

1394

check.traps ; check traps

1395

1396

TAG_470:

1397

check.traps ; check traps

1398

1399

TAG_499:

1400

check.traps ; check traps

1401

1402

TAG_500:

1403

check.traps ; check traps

1404

1405

TAG_510:

1406

check.traps ; check traps

1407

1408

TAG_520:

1409

check.traps ; check traps

1410

1411

TAG_530:

1412

check.traps ; check traps

1413

1414

TAG_540:

1415

check.traps ; check traps

1416

1417

TAG_550:

1418

check.traps ; check traps

1419

1420

TAG_560:

1421

check.traps ; check traps

1422

1423

TAG_570:

1424

check.traps ; check traps

1425

1426

;---------------------------------------------------------------------------------------------------------

1427

; PROGRAM END CODE

1428

;---------------------------------------------------------------------------------------------------------

1429

1430

end_pgm: __call_bios BIOS_DSPFNK ; turn on function keys display

1431

ld a, 1 ;

1432

ld (BIOS_CLIKSW), a ; enable keyboard click

1433

1434

;if defined COMPILE_TO_DOS or defined COMPILE_TO_ROM

1435

; __call_bios BIOS_RESET ; restart Basic

1436

;else

1437

; __call_basic BASIC_END ; end to Basic

1438

;endif

1439

1440

__call_basic BASIC_READYR ; warm start Basic

1441

1442

;__call_bios BIOS_GICINI ; initialize sound system

1443

1444

ret ; end of the program

1445

1446

1447

1448

DATA_SET_ITEMS_START:

1449

DATA_SET_ITEMS_COUNT: equ 0

1450

1451

1452

;--------------------------------------------------------

1453

; MSX BASIC KEYWORDS

1454

;--------------------------------------------------------

1455

1456

; keyword

1457

LET:

1458

1459

; out IX = variable assigned address

1460

pop.parm ; get variable address parameter

1461

push hl ; just to transfer hl to ix

1462

pop ix ;

1463

ld a, (ix) ; get variable type

1464

cp 3 ; test if string

1465

jr nz, LET.PARM ; if not a string, it isn't necessary to free memory

1466

ld a, (ix + 3) ; get variable string length

1467

or a ; cp 0

1468

jr z, LET.PARM ; if zero, it isn't necessary to free memory

1469

ld c, (ix + 4) ; get old string address low

1470

ld b, (ix + 5) ; get old string address high

1471

push ix ; save variable address

1472

push bc ; just to transfer bc (old string address) to ix

1473

pop ix ;

1474

call memory.free ; free memory

1475

pop ix ; restore variable address

1476

LET.PARM: pop.parm ; get data address parameter (out hl = data address)

1477

ld a, (ix + 2) ; get variable type flag

1478

or a ; cp 0 - test type flag (0=any, 255=fixed)

1479

jr nz, LET.FIXED ; if type flag is fixed, so casting is necessary

1480

LET.ANY: push ix ; just to transfer ix (variable address) to de

1481

pop de ;

1482

ldi ; copy 1 byte from hl (data address) to de (variable address)

1483

inc de ; go to variable data area

1484

inc de ;

1485

inc hl ; go to data data area

1486

inc hl ;

1487

ld bc, 8 ; data = 8 bytes

1488

ldir ; copy bc bytes from hl (data address) to de (variable address)

1489

ld a, (ix) ; get variable type

1490

cp 3 ; test if string

1491

ret nz ; if not string, return

1492

jp LET.STRING ; else do string treatment (in ix = variable address)

1493

LET.FIXED: push ix ; save variable destination address

1494

push hl ; save variable source address

1495

ld a, (ix) ; get variable fixed type, and hl has parameter data address

1496

call CAST_TO ; cast data to type (in hl = variable address, a = type to, out hl = casted data address)

1497

pop de

1498

pop ix ; restore variable address

1499

ld a, (ix) ; get variable destination type again

1500

cp 3 ; test if string

1501

jr nz, LET.VALUE ; if not string, do value treatment

1502

ld a, (de) ; get variable source type again

1503

cp 3 ; test if string

1504

jr nz, LET.FIX1 ; if not string, get casted string size

1505

inc de

1506

inc de

1507

inc de

1508

ld a, (de)

1509

ld (ix + 3), a ; source string size

1510

jr LET.FIX2

1511

LET.FIX1: push hl

1512

call GET_STR.LENGTH ; get string length (in HL, out B)

1513

pop hl

1514

ld (ix + 3), b ; set variable length

1515

LET.FIX2: ld (ix + 4), l ; casted data address low

1516

ld (ix + 5), h ; casted data address high

1517

jp LET.STRING ; do string treatment (in ix = variable address)

1518

LET.VALUE: push ix ; just to transfer ix (variable address) to de

1519

pop de ;

1520

inc de ; go to variable data area (and the data from its casted)

1521

inc de ;

1522

inc de ;

1523

ld bc, 8 ; data = 8 bytes

1524

ldir ; copy bc bytes from hl (data address) to de (variable address)

1525

ret ;

1526

LET.STRING: ld a, (ix + 3) ; string size

1527

or a ; cp 0 - test if null

1528

jr nz, LET.ALLOC ; if not null, allocate new string (in ix = variable address)

1529

ld bc, LIT_NULL_STR ; else, set to a null string literal

1530

ld (ix + 4), c ; variable address low

1531

ld (ix + 5), b ; variable address high

1532

ret ;

1533

LET.ALLOC: push ix ; save variable address

1534

ld l, (ix + 4) ; source string address low

1535

ld h, (ix + 5) ; source string address high

1536

push hl ; save copy from address

1537

ld c, (ix + 3) ; get variable length

1538

ld b, 0 ;

1539

inc bc ; string length have one more byte from zero terminator

1540

push bc ; save variable lenght + 1

1541

call memory.alloc ; in bc = size, out ix = address, nz=OK

1542

jp z, memory.error

1543

push ix ; just to transfer memory address from ix to de

1544

pop de ;

1545

pop bc ; restore bytes to be copied

1546

pop hl ; restore copy from string address

1547

push de ; save copy to address

1548

ldir ; copy bc bytes from hl (data address) to de (variable address)

1549

;xor a

1550

;ld (de), a

1551

pop de ; restore copy to address

1552

pop ix ; restore variable address

1553

ld (ix + 4), e ; put memory address low into variable

1554

ld (ix + 5), d ; put memory address high into variable

1555

ret ; variable assigned

1556

1557

; keyword

1558

BOOLEAN.IF:

1559

1560

pop.parm ; get parameter boolean result in hl

1561

push hl ; ix = hl

1562

pop ix ;

1563

ld a, (ix+5) ; put boolean integer result in a

1564

ret ;

1565

1566

; keyword

1567

INTERVAL_OFF:

1568

1569

ld hl, BASIC_TRPTBL_INTERVAL

1570

__call_basic BASIC_TRAP_DISABLE

1571

ret

1572

1573

; keyword

1574

SPRITE_OFF:

1575

1576

ld hl, BASIC_TRPTBL_SPRITE

1577

__call_basic BASIC_TRAP_DISABLE

1578

ret

1579

1580

; keyword

1581

SCREEN:

1582

1583

pop.parm ; get first parameter

1584

call CAST_TO.INT ;

1585

call GET_INT.VALUE ; output BC with integer value

1586

ld a, c ; A = screen number (0 to 3)

1587

cp 9

1588

jr c, SCREEN.1 ; if mode < 9, jump

1589

ld a, 8 ; else, fix to 8

1590

SCREEN.1:

1591

if DATA_SET_ITEMS_COUNT > 0

1592

call gfxSetScreenMode

1593

call gfxIsTileMode

1594

ret nz

1595

1596

jp gfxClearTileScreen

1597

else

1598

jp gfxSetScreenMode

1599

endif

1600

1601

; keyword

1602

COLOR:

1603

1604

;call gfxSetColor

1605

__call_bios BIOS_CHGCLR ; change VDP colors

1606

ret ;

1607

1608

; keyword

1609

COLOR_FOREGROUND:

1610

1611

pop.parm ; get first parameter

1612

call CAST_TO.INT ;

1613

call GET_INT.VALUE ; output BC with integer value

1614

ld a, c ; A = pixel color

1615

;call gfxSetForeColor

1616

ld (BIOS_FORCLR), a ; foreground color

1617

ld (BIOS_ATRBYT), a

1618

ret ;

1619

1620

; keyword

1621

COLOR_BACKGROUND:

1622

1623

pop.parm ; get first parameter

1624

call CAST_TO.INT ;

1625

call GET_INT.VALUE ; output BC with integer value

1626

ld a, c ; A = pixel color

1627

;call gfxSetBackColor

1628

ld (BIOS_BAKCLR), a ; foreground color

1629

ret ;

1630

1631

; keyword

1632

COLOR_BORDER:

1633

1634

pop.parm ; get first parameter

1635

call CAST_TO.INT ;

1636

call GET_INT.VALUE ; output BC with integer value

1637

ld a, c ; A = pixel color

1638

;call gfxSetBorderColor

1639

ld (BIOS_BDRCLR), a ; border color

1640

ret ;

1641

1642

; keyword

1643

CLS:

1644

1645

if DATA_SET_ITEMS_COUNT > 0

1646

call gfxIsTileMode

1647

jp z, gfxClearTileScreen

1648

endif

1649

xor a ; reset Z flag

1650

__call_bios BIOS_CLS ; clear screen

1651

ret ;

1652

1653

; keyword

1654

LOCATE:

1655

1656

pop.parm ; get first parameter

1657

call CAST_TO.INT ;

1658

call GET_INT.VALUE ; output BC with integer value

1659

pop.parm ; get second parameter

1660

push bc ; save first parameter as integer

1661

call CAST_TO.INT ;

1662

call GET_INT.VALUE ; output BC with integer value

1663

inc c ; BASIC has start position on 0,0 instead of 1,1 of BIOS

1664

ld l, c ; set second parameter (L = Y position)

1665

pop bc ; restore first parameter as integer

1666

inc c ; BASIC has start position on 0,0 instead of 1,1 of BIOS

1667

ld h, c ; set first parameter (H = X position)

1668

ld a, (BIOS_SCRMOD) ; 0=40x24 Text Mode, 1=32x24 Text Mode, 2=Graphics Mode, 3=Multicolour Mode

1669

cp 2 ;

1670

jr nc, LOCATE.G ; jump if graphic screen mode (not a < 2)

1671

LOCATE.T: __call_bios BIOS_POSIT ; H = X, L = Y

1672

ret ;

1673

LOCATE.G: ld b, 0 ;

1674

ld c, h ;

1675

ld d, 0 ;

1676

ld e, l ;

1677

ld (BIOS_GRPACX), bc ;

1678

ld (BIOS_GRPACY), de ;

1679

__call_bios BIOS_SCALXY ; BC = X, DE = Y

1680

__call_bios BIOS_MAPXYC ; BC = X, DE = Y

1681

ret ;

1682

1683

; keyword

1684

PRINT:

1685

1686

pop.parm ; get first parameter

1687

call CAST_TO.STR ;

1688

or 0

1689

ret z ; return if string size zero

1690

if DATA_SET_ITEMS_COUNT > 0

1691

ld (BIOS_TEMP), a ; size of string

1692

call gfxIsTileMode

1693

ld a, (BIOS_TEMP)

1694

jp nz, STRING.PRINT

1695

; discard if first char < 32 or > 126

1696

ld a, (hl)

1697

cp 126

1698

ret nc

1699

cp 31

1700

ret c

1701

push hl

1702

; adjust default color

1703

ld a, (BIOS_GRPACY)

1704

sra a

1705

sra a

1706

sra a ; Y / 8 = bank

1707

ld (BIOS_TEMP+1), a

1708

ld a, (BIOS_TEMP)

1709

PRINT.1:

1710

push af

1711

ld a, (BIOS_TEMP+1)

1712

ld d, a

1713

ld e, (hl)

1714

push hl

1715

call gfxSetTileDefaultColor

1716

pop hl

1717

inc hl

1718

pop af

1719

dec a

1720

jr nz, PRINT.1

1721

; print string

1722

ld hl, (BIOS_GRPACY)

1723

;ld bc, 32

1724

;call MATH.MULT.16 ; slow y * 32

1725

ld h, l

1726

sra h

1727

sra h

1728

sra h

1729

sla l

1730

sla l

1731

sla l

1732

sla l

1733

sla l ; fast y * 32

1734

ld de, (BIOS_GRPACX)

1735

add hl, de

1736

ld de, (BIOS_GRPNAM)

1737

add hl, de

1738

ex de, hl

1739

pop hl

1740

ld b, 0

1741

ld a, (BIOS_TEMP)

1742

ld c, a

1743

jp gfxLDIRVM

1744

else

1745

jp STRING.PRINT

1746

endif

1747

1748

; keyword

1749

SET_PLAY_VOICE_1:

1750

1751

ld a, 0

1752

jp SET_PLAY_VOICE

1753

1754

; keyword

1755

DO_PLAY:

1756

1757

call START_PLAY

1758

1759

; keyword

1760

STRIG:

1761

1762

pop.parm ; get first parameter

1763

call CAST_TO.INT ;

1764

call GET_INT.VALUE ; output BC with integer value

1765

ld a, c

1766

__call_bios BIOS_GTTRIG

1767

or a ; cp 0

1768

jp z, BOOLEAN.RET.FALSE ;

1769

jp BOOLEAN.RET.TRUE

1770

1771

; keyword

1772

BOOLEAN.OR:

1773

1774

call MATH.PARM.POP ; get parameters into DAC/ARG

1775

ld a, (BASIC_VALTYP) ;

1776

cp 2 ; test if integer

1777

jp z, BOOLEAN.OR.INT ;

1778

jp MATH.ERROR ; it is a double

1779

1780

; keyword

1781

GOTO:

1782

; abstract virtual GOTO

1783

; keyword

1784

PLAY:

1785

1786

pop.parm ;

1787

call CAST_TO.INT ;

1788

call GET_INT.VALUE ; output BC with integer value

1789

xor a

1790

or c

1791

jr nz,PLAY.1

1792

ld c, 7 ; 3 bits on

1793

jr PLAY.2

1794

PLAY.1:

1795

ld a, c

1796

cp 3

1797

jr nz,PLAY.2

1798

ld c, 4

1799

PLAY.2:

1800

1801

ld a, (BIOS_MUSICF)

1802

1803

and c

1804

jp z, BOOLEAN.RET.FALSE ;

1805

jp BOOLEAN.RET.TRUE

1806

1807

; keyword

1808

BEEP:

1809

1810

__call_bios BIOS_BEEP ; play a beep in the system speaker

1811

ret ;

1812

1813

; keyword

1814

SPRITEMODE:

1815

1816

pop.parm ; get first parameter

1817

call CAST_TO.INT ;

1818

call GET_INT.VALUE ; output BC with integer value

1819

ld a, c ; A = sprite mode (0 to 3)

1820

jp gfxSetSpriteMode

1821

1822

; keyword

1823

RESTORE:

1824

1825

ld hl, DATA_ITEMS

1826

ld (BASIC_DATPTR), hl ; data items pointer

1827

ld hl, 0

1828

ld (BASIC_DATLIN), hl ; data items index

1829

ret

1830

1831

; keyword

1832

GOSUB:

1833

; abstract virtual GOSUB

1834

; keyword

1835

ON_SPRITE:

1836

1837

pop.parm ; get first parameter in HL

1838

call CAST_TO.INT ;

1839

call GET_INT.VALUE ; put parameter into BC (trap handler)

1840

;push bc

1841

;pop de

1842

ld d, b

1843

ld e, c

1844

ld hl, BASIC_TRPTBL_SPRITE

1845

jp SET_TRAP ; hl = trap block, de = trap handler pointer

1846

1847

; keyword

1848

ON_INTERVAL:

1849

1850

pop.parm ; get first parameter in HL

1851

call CAST_TO.INT ;

1852

call GET_INT.VALUE ; put parameter into BC (interval value)

1853

1854

ld (BASIC_INTVAL), bc

1855

ld (BASIC_INTCNT), bc

1856

1857

pop.parm ; get first parameter in HL

1858

call CAST_TO.INT ;

1859

call GET_INT.VALUE ; put parameter into BC (trap handler)

1860

;push bc

1861

;pop de

1862

ld d, b

1863

ld e, c

1864

ld hl, BASIC_TRPTBL_INTERVAL

1865

jp SET_TRAP ; hl = trap block, de = trap handler pointer

1866

1867

; keyword

1868

FOR:

1869

; abstract virtual FOR

1870

; keyword

1871

MATH.ADD:

1872

1873

call MATH.PARM.POP ; get parameters into DAC/ARG

1874

ld a, (BASIC_VALTYP) ;

1875

cp 2 ; test if integer

1876

jp z, MATH.ADD.INT ;

1877

cp 3 ; test if string

1878

jp z, STRING.CONCAT ;

1879

cp 4 ; test if single

1880

jp z, MATH.ADD.SGL ;

1881

jp MATH.ADD.DBL ; it is a double

1882

1883

; keyword

1884

BOOLEAN.LE:

1885

1886

call MATH.PARM.POP ; get parameters into DAC/ARG

1887

ld a, (BASIC_VALTYP) ;

1888

cp 2 ; test if integer

1889

jp z, BOOLEAN.LE.INT ;

1890

cp 3 ; test if string

1891

jp z, BOOLEAN.LE.STR ;

1892

cp 4 ; test if single

1893

jp z, BOOLEAN.LE.SGL ;

1894

jp BOOLEAN.LE.DBL ; it is a double

1895

1896

; keyword

1897

INT:

1898

1899

pop.parm ; get first parameter in HL

1900

call CAST_TO.INT ;

1901

call GET_INT.VALUE ; put parameter into BC

1902

call COPY_TO.VAR_DUMMY.INT ; create a fake integer variable from BC in HL

1903

ret.parm ;

1904

1905

; keyword

1906

RND:

1907

1908

pop.parm ; get parameter

1909

call COPY_TO.DAC ; put in DAC

1910

and 12 ; test if single/double

1911

jr nz, RND.1 ; if already double

1912

__call_bios MATH_FRCDBL ; convert DAC to double

1913

RND.1: __call_bios MATH_RND ; put in DAC a new random number from previous DAC parameter

1914

jp MATH.PARM.PUSH ; return a dummy double variable from DAC

1915

1916

; keyword

1917

MATH.MULT:

1918

1919

call MATH.PARM.POP ; get parameters into DAC/ARG

1920

ld a, (BASIC_VALTYP) ;

1921

cp 2 ; test if integer

1922

jp z, MATH.MULT.INT ;

1923

cp 3 ; test if string

1924

jp z, MATH.ERROR ;

1925

cp 4 ; test if single

1926

jp z, MATH.MULT.SGL ;

1927

jp MATH.MULT.DBL ; it is a double

1928

1929

; keyword

1930

PSET:

1931

1932

jp gfxSetPixel

1933

1934

; keyword

1935

PSET.XY:

1936

1937

pop.parm ; get first parameter

1938

call CAST_TO.INT ;

1939

call GET_INT.VALUE ; output BC with integer value

1940

ld (BIOS_GRPACX), bc ; X

1941

pop.parm ; get second parameter

1942

call CAST_TO.INT ;

1943

call GET_INT.VALUE ; output BC with integer value

1944

ld (BIOS_GRPACY), bc ; Y

1945

jp gfxRefreshXY

1946

1947

; keyword

1948

PSET.COLOR:

1949

1950

pop.parm ; get first parameter

1951

call CAST_TO.INT ;

1952

call GET_INT.VALUE ; output BC with integer value

1953

ld a, c

1954

call gfxSetForeColor

1955

jp gfxSetColor

1956

1957

; keyword

1958

1959

; abstract virtual NEXT

1960

; keyword

1961

INTERVAL_ON:

1962

1963

ld hl, BASIC_TRPTBL_INTERVAL

1964

__call_basic BASIC_TRAP_ENABLE

1965

ret

1966

1967

; keyword

1968

SPRITE_ON:

1969

1970

ld hl, BASIC_TRPTBL_SPRITE

1971

__call_basic BASIC_TRAP_ENABLE

1972

ret

1973

1974

; keyword

1975

STICK:

1976

1977

pop.parm ; get first parameter

1978

call CAST_TO.INT ;

1979

call GET_INT.VALUE ; output BC with integer value

1980

ld a, c

1981

__call_bios BIOS_GTSTCK

1982

ld b, 0 ;

1983

ld c, a ;

1984

call COPY_TO.VAR_DUMMY.INT ; create a fake integer variable from BC in HL

1985

ret.parm ;

1986

1987

; keyword

1988

BOOLEAN.EQ:

1989

1990

call MATH.PARM.POP ; get parameters into DAC/ARG

1991

ld a, (BASIC_VALTYP) ;

1992

cp 2 ; test if integer

1993

jp z, BOOLEAN.EQ.INT ;

1994

cp 3 ; test if string

1995

jp z, BOOLEAN.EQ.STR ;

1996

cp 4 ; test if single

1997

jp z, BOOLEAN.EQ.SGL ;

1998

jp BOOLEAN.EQ.DBL ; it is a double

1999

2000

; keyword

2001

BOOLEAN.LT:

2002

2003

call MATH.PARM.POP ; get parameters into DAC/ARG

2004

ld a, (BASIC_VALTYP) ;

2005

cp 2 ; test if integer

2006

jp z, BOOLEAN.LT.INT ;

2007

cp 3 ; test if string

2008

jp z, BOOLEAN.LT.STR ;

2009

cp 4 ; test if single

2010

jp z, BOOLEAN.LT.SGL ;

2011

jp BOOLEAN.LT.DBL ; it is a double

2012

2013

; keyword

2014

BOOLEAN.AND:

2015

2016

call MATH.PARM.POP ; get parameters into DAC/ARG

2017

ld a, (BASIC_VALTYP) ;

2018

cp 2 ; test if integer

2019

jp z, BOOLEAN.AND.INT ;

2020

jp MATH.ERROR ; it is a double

2021

2022

; keyword

2023

BOOLEAN.GT:

2024

2025

call MATH.PARM.POP ; get parameters into DAC/ARG

2026

ld a, (BASIC_VALTYP) ;

2027

cp 2 ; test if integer

2028

jp z, BOOLEAN.GT.INT ;

2029

cp 3 ; test if string

2030

jp z, BOOLEAN.GT.STR ;

2031

cp 4 ; test if single

2032

jp z, BOOLEAN.GT.SGL ;

2033

jp BOOLEAN.GT.DBL ; it is a double

2034

2035

; keyword

2036

MATH.SUB:

2037

2038

call MATH.PARM.POP ; get parameters into DAC/ARG

2039

ld a, (BASIC_VALTYP) ;

2040

cp 2 ; test if integer

2041

jp z, MATH.SUB.INT ;

2042

cp 3 ; test if string

2043

jp z, MATH.ERROR ;

2044

cp 4 ; test if single

2045

jp z, MATH.SUB.SGL ;

2046

jp MATH.SUB.DBL ; it is a double

2047

2048

; keyword

2049

PUT_SPRITE_COLOR:

2050

2051

pop.parm ; get sprite number

2052

call CAST_TO.INT ;

2053

call GET_INT.VALUE ; output BC with integer value

2054

ld (GFX_TEMP), bc ; sprite number

2055

2056

pop.parm ; get X

2057

call CAST_TO.INT ;

2058

call GET_INT.VALUE ; output BC with integer value

2059

ld (GFX_TEMP1), bc ; X

2060

2061

pop.parm ; get Y

2062

call CAST_TO.INT ;

2063

call GET_INT.VALUE ; output BC with integer value

2064

ld (GFX_TEMP2), bc ; Y

2065

2066

pop.parm ; get color

2067

call CAST_TO.INT ;

2068

call GET_INT.VALUE ; output BC with integer value

2069

ld (GFX_TEMP3), bc ; color

2070

2071

ld bc, (GFX_TEMP2)

2072

ld a, (GFX_TEMP1)

2073

ld b, a

2074

ld a, (GFX_TEMP)

2075

call gfxSetSpriteXY

2076

2077

ld a, (GFX_TEMP)

2078

ld bc, (GFX_TEMP3)

2079

call gfxSetSpriteColorInt

2080

2081

ld bc, (GFX_TEMP) ; sprite number

2082

jp gfxUpdateSpriteCollisionTable

2083

2084

; keyword

2085

RETURN:

2086

; abstract virtual RETURN

2087

; keyword

2088

MATH.NEG:

2089

2090

call CLEAR.DAC ; put zero in DAC

2091

pop.parm ; get parameter

2092

call COPY_TO.ARG ; put in ARG

2093

cp 2 ; test if integer

2094

jp z, MATH.SUB.INT ;

2095

cp 4 ; test if single

2096

jp z, MATH.SUB.SGL ;

2097

cp 8 ; test if double

2098

jp z, MATH.SUB.DBL ;

2099

jp MATH.ERROR ;

2100

2101

; keyword

2102

MATH.MOD:

2103

2104

call MATH.PARM.POP.INT ; get parameters as integer into DAC/ARG

2105

jp MATH.MOD.INT ;

2106

2107

; keyword

2108

FBOX:

2109

2110

pop.parm ; get first parameter

2111

call CAST_TO.INT ;

2112

call GET_INT.VALUE ; output BC with integer value

2113

ld (GFX_TEMP1), bc ; dX

2114

pop.parm ; get second parameter

2115

call CAST_TO.INT ;

2116

call GET_INT.VALUE ; output BC with integer value

2117

;push bc ; dY

2118

;pop de

2119

ld d, b

2120

ld e, c

2121

ld bc, (GFX_TEMP1) ; dX

2122

or 1 ; a = 1 (filled box)

2123

jp gfxDrawBox

2124

2125

; keyword

2126

READ:

2127

2128

pop.parm ; get first parameter (variable to be read)

2129

push hl ; save input variable...

2130

xor a ; clear carry

2131

ld hl, (BASIC_DATLIN) ; index of data items

2132

ld de, DATA_ITEMS_COUNT ; count of data items

2133

sbc hl, de ; compare hl >= de

2134

jr z, READ.END ; jump if equal

2135

jr nc, READ.END ; jump if above

2136

pop de ; restore saved input variable to DE

2137

ld ix, (BASIC_DATPTR) ; data items pointer

2138

ld l, (ix)

2139

ld h, (ix+1)

2140

push.parm ; LET parameter 2 - data as right operand

2141

ex de, hl ; put DE into HL

2142

push.parm ; LET parameter 1 - input variable as left operand

2143

call LET ; put data into variable

2144

ld hl, (BASIC_DATLIN) ; old index of data items

2145

inc hl ; next item

2146

ld (BASIC_DATLIN), hl ; save new index of data items

2147

ld hl, (BASIC_DATPTR) ; old data items pointer

2148

push hl

2149

inc hl ; next item

2150

inc hl ; next item

2151

ld (BASIC_DATPTR), hl ; save new data items pointer

2152

READ.END: pop hl

2153

ret

2154

2155

; keyword

2156

CHR:

2157

2158

pop.parm ; get first parameter

2159

call CAST_TO.INT ;

2160

call GET_INT.VALUE ; output BC with integer value

2161

push bc

2162

ld bc, 2 ; string size

2163

call memory.alloc ; in bc size, out ix new memory address, nz=OK

2164

jp z, memory.error ;

2165

pop bc

2166

ld a, c ; A = char

2167

ld (ix), a

2168

xor a

2169

ld (ix+1), a

2170

push ix

2171

pop hl

2172

ld a, 1

2173

call COPY_TO.VAR_DUMMY.STR ; create a fake string variable from HL in HL

2174

ret.parm ;

2175

2176

; keyword

2177

SPRITE:

2178

2179

pop.parm ; get sprite number

2180

call CAST_TO.INT ;

2181

call GET_INT.VALUE ; output BC with integer value

2182

ld (GFX_TEMP), bc ; sprite number

2183

2184

pop.parm ; get sprite data

2185

ld a, (hl)

2186

cp 3 ; is string?

2187

ret nz

2188

2189

call GET_STR.ADDR ; put string address into hl

2190

or a

2191

ret z ; is string empty?

2192

2193

ld c, a ; string size

2194

ld a, (GFX_TEMP) ; sprite number

2195

call gfxSetSpriteData

2196

2197

ld a, (GFX_TEMP)

2198

ld b, 0

2199

ld c, a ; sprite number

2200

call gfxSetSpritePattern

2201

2202

ld b, 0

2203

ld a, (BIOS_FORCLR)

2204

ld c, a

2205

ld a, (GFX_TEMP)

2206

call gfxSetSpriteColorInt

2207

2208

ret

2209

2210

; keyword

2211

DATA:

2212

; abstract virtual DATA

2213

2214

2215

2216

;---------------------------------------------------------------------------------------------------------

2217

; VARIABLES INITIALIZE

2218

;---------------------------------------------------------------------------------------------------------

2219

2220

INITIALIZE_DUMMY:

2221

xor a

2222

ld (VAR_DUMMY.COUNTER), a ; max circular queue = 8 dummys

2223

ld hl, VAR_DUMMY.DATA ; start of variable dummy circular queue

2224

ld (VAR_DUMMY.POINTER), hl

2225

ld b, VAR_DUMMY.LENGTH

2226

ld c, 0

2227

INITIALIZE_DUMMY.1:

2228

ld (hl), a

2229

inc hl

2230

djnz INITIALIZE_DUMMY.1

2231

ret

2232

2233

INITIALIZE_DATA:

2234

ld hl, DATA_ITEMS

2235

ld (BASIC_DATPTR), hl ; next DATA pointer to use by READ command

2236

ld hl, 0

2237

ld (BASIC_DATLIN), hl ; index of DATA item to use by READ command

2238

ret

2239

2240

INITIALIZE_VARIABLES:

2241

call INITIALIZE_DATA

2242

call INITIALIZE_DUMMY

2243

2244

if defined SCREEN

2245

call gfxInitSpriteCollisionTable

2246

endif

2247

2248

;if defined COMPILE_TO_ROM

2249

; ld ix, BIOS_JIFFY ; initialize rom clock

2250

; di

2251

; ld (ix), 0

2252

; ld (ix+1), 0

2253

; ei

2254

;endif

2255

2256

2257

ld hl, IDF_14

2258

ld d, 2 ; any = default integer

2259

ld c, 0 ; variable name 1 (variable number)

2260

ld b, 0 ; variable name 2 (type flag=any)

2261

call INIT_VAR ; variable initialize

2262

ld hl, IDF_16

2263

ld d, 2 ; any = default integer

2264

ld c, 1 ; variable name 1 (variable number)

2265

ld b, 0 ; variable name 2 (type flag=any)

2266

call INIT_VAR ; variable initialize

2267

ld hl, IDF_18

2268

ld d, 2 ; any = default integer

2269

ld c, 2 ; variable name 1 (variable number)

2270

ld b, 0 ; variable name 2 (type flag=any)

2271

call INIT_VAR ; variable initialize

2272

ld hl, IDF_20

2273

ld d, 2 ; any = default integer

2274

ld c, 3 ; variable name 1 (variable number)

2275

ld b, 0 ; variable name 2 (type flag=any)

2276

call INIT_VAR ; variable initialize

2277

ld hl, IDF_22

2278

ld d, 2 ; any = default integer

2279

ld c, 4 ; variable name 1 (variable number)

2280

ld b, 0 ; variable name 2 (type flag=any)

2281

call INIT_VAR ; variable initialize

2282

ld hl, IDF_24

2283

ld d, 2 ; any = default integer

2284

ld c, 5 ; variable name 1 (variable number)

2285

ld b, 0 ; variable name 2 (type flag=any)

2286

call INIT_VAR ; variable initialize

2287

ld hl, IDF_26

2288

ld d, 3 ; string

2289

ld c, 6 ; variable name 1 (variable number)

2290

ld b, 255 ; variable name 2 (type flag=fixed)

2291

call INIT_VAR ; variable initialize

2292

ld hl, IDF_42

2293

ld d, 2 ; integer

2294

ld c, 7 ; variable name 1 (variable number)

2295

ld b, 255 ; variable name 2 (type flag=fixed)

2296

call INIT_VAR ; variable initialize

2297

ld hl, IDF_71

2298

ld d, 2 ; any = default integer

2299

ld c, 8 ; variable name 1 (variable number)

2300

ld b, 0 ; variable name 2 (type flag=any)

2301

call INIT_VAR ; variable initialize

2302

ld hl, IDF_118

2303

ld d, 2 ; any = default integer

2304

ld c, 9 ; variable name 1 (variable number)

2305

ld b, 0 ; variable name 2 (type flag=any)

2306

call INIT_VAR ; variable initialize

2307

ld hl, IDF_171

2308

ld d, 3 ; string

2309

ld c, 10 ; variable name 1 (variable number)

2310

ld b, 255 ; variable name 2 (type flag=fixed)

2311

call INIT_VAR ; variable initialize

2312

ld hl, IDF_177

2313

ld d, 2 ; any = default integer

2314

ld c, 11 ; variable name 1 (variable number)

2315

ld b, 0 ; variable name 2 (type flag=any)

2316

call INIT_VAR ; variable initialize

2317

ld hl, IDF_179

2318

ld d, 3 ; string

2319

ld c, 12 ; variable name 1 (variable number)

2320

ld b, 255 ; variable name 2 (type flag=fixed)

2321

call INIT_VAR ; variable initialize

2322

ret

2323

2324

2325

;---------------------------------------------------------------------------------------------------------

2326

; PROGRAM ROUTINES

2327

;---------------------------------------------------------------------------------------------------------

2328

2329

BIOS_BASIC_SLOT_ENABLE:

2330

ld a, (BIOS_EXPTBL)

2331

ld hl,0

2332

__call_bios BIOS_ENASLT ; Select main ROM on page 0 (0000h~3FFFh)

2333

2334

if defined COMPILE_TO_BIN or defined COMPILE_TO_DOS

2335

2336

ld a, (BIOS_EXPTBL)

2337

ld hl,04000h

2338

__call_bios BIOS_ENASLT ; Select main ROM on page 1 (4000h~7FFFh)

2339

2340

endif

2341

2342

ret

2343

2344

if defined ON_ERROR or defined ON_INTERVAL or defined ON_KEY_START or defined ON_SPRITE or defined ON_STOP or defined ON_STRIG_START or defined TRAP_ENABLED or defined TRAP_DISABLED or defined TRAP_PAUSE or defined TRAP_UNPAUSE

2345

2346

RUN_TRAPS: ld b, 26

2347

ld hl, BASIC_TRPTBL

2348

RUN_TRAPS.1: push hl

2349

push bc

2350

call TRAP_HANDLER

2351

pop bc

2352

pop hl

2353

inc hl

2354

inc hl

2355

inc hl

2356

djnz RUN_TRAPS.1

2357

ret

2358

2359

; in hl = trap block address (handle trap: sts=5? has handler? ackn, pause, run trap, sts=1? unpause)

2360

TRAP_HANDLER:

2361

ld a, (hl) ; trap status

2362

cp 5 ; trap occured AND trap not paused AND trap enabled ?

2363

ret nz ; return if false

2364

inc hl

2365

ld e, (hl) ; get trap address

2366

inc hl

2367

ld d, (hl)

2368

dec hl

2369

dec hl

2370

ld a, d

2371

or e

2372

ret z ; return if address zero

2373

push hl

2374

__call_basic BASIC_TRAP_ACKNW

2375

__call_basic BASIC_TRAP_PAUSE

2376

ld hl, TRAP_HANDLER.1

2377

ld a, (BASIC_ONGSBF) ; save traps execution

2378

push af

2379

xor a

2380

ld (BASIC_ONGSBF), a ; disable traps execution

2381

push hl ; next return will be to trap handler

2382

push de ; indirect jump to trap address

2383

ret

2384

TRAP_HANDLER.1: pop af

2385

ld (BASIC_ONGSBF), a ; restore traps execution

2386

pop hl

2387

ld a, (hl)

2388

cp 1 ; trap enabled?

2389

ret z

2390

__call_basic BASIC_TRAP_UNPAUSE

2391

ret

2392

2393

; hl = trap block, de = trap handler

2394

SET_TRAP: xor a

2395

ld (hl), a ; trap block status

2396

inc hl

2397

ld (hl), e ; trap block handler (pointer)

2398

inc hl

2399

ld (hl), d

2400

ret

2401

2402

endif

2403

2404

if defined SET_PLAY_VOICE_1 or defined SET_PLAY_VOICE_2 or defined SET_PLAY_VOICE_3 or defined DO_PLAY or defined MUSIC_PLAY or defined MUSIC_NEXT or defined MUSIC_STOP

2405

2406

SET_PLAY_VOICE:

2407

ld (BIOS_TEMP), a ; save voice number

2408

pop.parm

2409

ld a, (hl)

2410

cp 3

2411

ret nz ; return if not string

2412

call GET_STR.ADDR

2413

SET_PLAY_VOICE.1:

2414

ld (BIOS_TEMP2), a ; save string size

2415

push hl ; string address

2416

ld a, (BIOS_TEMP) ; restore voice number

2417

__call_bios BIOS_GETVCP ; get PSG voice buffer address (in A = voice number, out HL = address of byte 2)

2418

pop de

2419

ld a, (BIOS_TEMP2) ; restore string size

2420

ld (hl), a ; string size

2421

inc hl

2422

ld (hl), e ; string address

2423

inc hl

2424

ld (hl), d

2425

inc hl

2426

ld D,H ; voice stack

2427

ld E,L

2428

ld BC,001CH

2429

add HL,BC

2430

ex DE,HL

2431

ld (HL),E

2432

inc HL

2433

ld (HL),D

2434

ret

2435

2436

endif

2437

2438

2439

2440

2441

;---------------------------------------------------------------------------------------------------------

2442

; VARIABLES ROUTINES

2443

;---------------------------------------------------------------------------------------------------------

2444

2445

; input hl = variable address

2446

; input bc = variable name

2447

; input d = variable type

2448

INIT_VAR: ld (hl), d ; variable type

2449

inc hl

2450

ld (hl), c ; variable name 1

2451

inc hl

2452

ld (hl), b ; variable name 2

2453

ld a, d

2454

cp 3

2455

jp nz, CLEAR.VAR

2456

ld de, LIT_NULL_STR

2457

inc hl

2458

ld (hl), 0

2459

inc hl

2460

ld (hl), e

2461

inc hl

2462

ld (hl), d

2463

ld b, 5

2464

jr CLEAR.VAR.LOOP

2465

CLEAR.VAR: ld b, 8

2466

CLEAR.VAR.LOOP: inc hl

2467

ld (hl), 0 ; data address/value

2468

djnz CLEAR.VAR.LOOP

2469

ret

2470

; input HL = variable address

2471

; input A = variable output type

2472

; output HL = casted data address

2473

CAST_TO: cp 2

2474

jp z, CAST_TO.INT

2475

cp 3

2476

jp z, CAST_TO.STR

2477

cp 4

2478

jp z, CAST_TO.SGL

2479

cp 8

2480

jp z, CAST_TO.DBL

2481

ret

2482

; input HL = variable address

2483

; output HL = variable address

2484

CAST_TO.INT: ;push af

2485

ld a, (HL)

2486

cp 2

2487

jp z, GET_INT.ADDR

2488

cp 3

2489

jp z, CAST_STR_TO.INT

2490

cp 4

2491

jp z, CAST_SGL_TO.INT

2492

cp 8

2493

jp z, CAST_DBL_TO.INT

2494

;pop af

2495

ret

2496

; input HL = variable address

2497

; output HL = variable address

2498

CAST_TO.STR: ;push af

2499

ld a, (HL)

2500

cp 2

2501

jp z, CAST_INT_TO.STR

2502

cp 3

2503

jp z, GET_STR.ADDR

2504

cp 4

2505

jp z, CAST_SGL_TO.STR

2506

cp 8

2507

jp z, CAST_DBL_TO.STR

2508

;pop af

2509

ret

2510

; input HL = variable address

2511

; output HL = variable address

2512

CAST_TO.SGL: ;push af

2513

ld a, (HL)

2514

cp 2

2515

jp z, CAST_INT_TO.SGL

2516

cp 3

2517

jp z, CAST_STR_TO.SGL

2518

cp 4

2519

jp z, GET_SGL.ADDR

2520

cp 8

2521

jp z, CAST_DBL_TO.SGL

2522

;pop af

2523

ret

2524

; input HL = variable address

2525

; output HL = variable address

2526

CAST_TO.DBL: ;push af

2527

ld a, (hl)

2528

cp 2

2529

jp z, CAST_INT_TO.DBL

2530

cp 3

2531

jp z, CAST_STR_TO.DBL

2532

cp 4

2533

jp z, CAST_SGL_TO.DBL

2534

cp 8

2535

jp z, GET_DBL.ADDR

2536

;pop af

2537

ret

2538

CAST_SGL_TO.STR: ; same as CAST_INT_TO.STR

2539

CAST_DBL_TO.STR: ; same as CAST_INT_TO.STR

2540

CAST_INT_TO.STR: call COPY_TO.DAC

2541

xor a

2542

__call_bios MATH_FOUT ; convert DAC to string

2543

;pop af

2544

ret

2545

CAST_INT_TO.SGL: call COPY_TO.DAC

2546

__call_bios MATH_FRCSGL

2547

ld hl, BASIC_DAC

2548

ret

2549

CAST_INT_TO.DBL: call COPY_TO.DAC

2550

__call_bios MATH_FRCDBL

2551

ld hl, BASIC_DAC

2552

ret

2553

CAST_SGL_TO.INT: ; same as CAST_DBL_TO.INT

2554

CAST_DBL_TO.INT: call COPY_TO.DAC

2555

__call_bios MATH_FRCINT

2556

ld hl, BASIC_DAC

2557

ret

2558

CAST_STR_TO.INT: call CAST_STR_TO.VAL ;

2559

__call_bios MATH_FRCINT ;

2560

ld hl, BASIC_DAC ;

2561

ret ;

2562

CAST_STR_TO.SGL: call CAST_STR_TO.VAL ;

2563

__call_bios MATH_FRCSGL ;

2564

ld hl, BASIC_DAC ;

2565

ret ;

2566

CAST_STR_TO.DBL: call CAST_STR_TO.VAL ;

2567

__call_bios MATH_FRCDBL ;

2568

ld hl, BASIC_DAC ;

2569

ret ;

2570

CAST_STR_TO.VAL: call GET_STR.ADDR ;

2571

ld a, (hl) ;

2572

__call_bios MATH_FIN ; convert string to a value type

2573

ld hl, BASIC_DAC ;

2574

ret ;

2575

GET_INT.VALUE: inc hl ; output BC with integer value

2576

inc hl ;

2577

ld c, (hl) ;

2578

inc hl ;

2579

ld b, (hl) ;

2580

ret ;

2581

CAST_SGL_TO.DBL: ; same as GET_DBL.ADDR

2582

CAST_DBL_TO.SGL: ; same as GET_DBL.ADDR

2583

GET_INT.ADDR: ; same as GET_DBL.ADDR

2584

GET_SGL.ADDR: ; same as GET_DBL.ADDR

2585

GET_DBL.ADDR: inc hl

2586

inc hl

2587

inc hl

2588

;pop af

2589

ret

2590

GET_STR.ADDR: push hl

2591

pop ix

2592

ld a, (ix + 3)

2593

ld l, (ix + 4)

2594

ld h, (ix + 5)

2595

ret

2596

; input hl = string address

2597

; output b = string length

2598

GET_STR.LENGTH: ld b, 0

2599

GET_STR.LEN.NEXT: ld a, (hl)

2600

or a ; cp 0

2601

ret z

2602

inc b

2603

inc hl

2604

ld a, b

2605

cp 255

2606

jr z, GET_STR.LEN.ERR

2607

jr GET_STR.LEN.NEXT

2608

GET_STR.LEN.ERR: ld b, 0

2609

ret

2610

STRING.COMPARE: ld ix, (BASIC_DAC+1) ; string 1

2611

ld iy, (BASIC_ARG+1) ; string 2

2612

STRING.COMPARE.NX: ld a, (ix) ; next char from string 1

2613

cp (iy) ; char s1 = char s2?

2614

jr nz, STRING.COMPARE.NE ; if not equal...

2615

cp 0 ;

2616

jr z, STRING.COMPARE.F1 ; if string 1 has finished...

2617

ld a, (iy) ; next char from string 2

2618

cp 0 ;

2619

jr z, STRING.COMPARE.GT ; if s2 has finished, s1 has not finished yet, so s1 is greater than s2

2620

inc ix ;

2621

inc iy ;

2622

jr STRING.COMPARE.NX ; get next char pair

2623

STRING.COMPARE.F1: ld a, (iy) ; verify if string 2 has finished too

2624

cp 0 ;

2625

jr z, STRING.COMPARE.EQ ; if s2 has finished, then they are equals

2626

jr STRING.COMPARE.LT ; else, result = s1 is less than s2

2627

STRING.COMPARE.NE: jr c, STRING.COMPARE.GT ; verify if s1 is greater than s2...

2628

STRING.COMPARE.LT: ld a, 1 ; ...else, result = s1 less than s2

2629

ret ;

2630

STRING.COMPARE.GT: ld a, 0xFF ; result = s1 is greater than s2

2631

ret ;

2632

STRING.COMPARE.EQ: xor a ; result = s1 is equal to s2

2633

ret ;

2634

STRING.CONCAT: ld ix, BASIC_DAC ; s1 size

2635

ld a, (BASIC_ARG) ; s2 size

2636

add a, (ix) ; s3 size = s1 size + s2 size

2637

push af

2638

ld b, 0

2639

ld c, a ;

2640

inc bc ; add 1 byte to size

2641

call memory.alloc ; in bc size, out ix new memory address, nz=OK

2642

jp z, memory.error ;

2643

push ix ; save ix

2644

push ix ; save ix

2645

pop de ; de = ix

2646

ld a, (BASIC_DAC) ; s1 size

2647

ld hl, (BASIC_DAC + 1) ; string 1

2648

call COPY_TO.STR ; copy to new memory

2649

ld a, (BASIC_ARG) ; s2 size

2650

ld hl, (BASIC_ARG + 1) ; string 2

2651

call COPY_TO.STR ; copy to new memory

2652

xor a

2653

ld (de), a ; null terminated

2654

pop hl ; hl = ix

2655

pop af

2656

call COPY_TO.VAR_DUMMY.STR ;

2657

ret.parm ; WARNING - VERIFY STRING MEMORY LEAKs

2658

STRING.PRINT: ld a, (BIOS_SCRMOD) ; 0=40x24 Text Mode, 1=32x24 Text Mode, 2=Graphics Mode, 3=Multicolour Mode

2659

cp 5 ;

2660

jr nc, STRING.PRINT.G2 ; jump if graphic screen mode MSX2 (>=5)

2661

cp 2 ;

2662

jr nc, STRING.PRINT.G1 ; jump if graphic screen mode MSX1 (>=2)

2663

STRING.PRINT.T: ld a, (hl) ; get a char from a string parameter

2664

or a ; cp 0 - is it the string end?

2665

ret z ; exit if yes

2666

__call_bios BIOS_CHPUT ; put the char (a) into text screen

2667

inc hl ; next char

2668

jr STRING.PRINT.T ; repeat

2669

STRING.PRINT.G1: ld a, (hl) ; get a char from a string parameter

2670

or a ; cp 0 - is it the string end?

2671

ret z ; exit if yes

2672

__call_bios BIOS_GRPPRT ; put the char (a) into graphical screen

2673

inc hl ; next char

2674

jr STRING.PRINT.G1 ; repeat

2675

STRING.PRINT.G2: ld a, (hl) ; get a char from a string parameter

2676

or a ; cp 0 - is it the string end?

2677

ret z ; exit if yes

2678

ld ix, BIOS_GRPPRT2 ; put the char (a) into graphical screen

2679

call BIOS_EXTROM

2680

inc hl ; next char

2681

jr STRING.PRINT.G2 ; repeat

2682

2683

; a = string size to copy

2684

; input hl = string from

2685

; input de = string to

2686

COPY_TO.STR: or a

2687

ret z ; avoid copy if size = zero

2688

ld b, 0

2689

ld c, a ; string size

2690

ldir ; copy bc bytes from hl to de

2691

ret ;

2692

COPY_TO.BASIC_BUF: ld bc, BASIC_BUF

2693

ld a, (LIT_QUOTE_CHAR)

2694

ld (bc), a

2695

inc bc

2696

COPY_BAS_BUF.LOOP: ld a, (hl)

2697

or a ; cp 0

2698

jr z, COPY_BAS_BUF.EXIT

2699

ld (bc), a

2700

inc bc

2701

inc hl

2702

jr COPY_BAS_BUF.LOOP

2703

COPY_BAS_BUF.EXIT: ld a, (LIT_QUOTE_CHAR)

2704

ld (bc), a

2705

inc bc

2706

xor a

2707

ld (bc), a

2708

ld hl, BASIC_BUF

2709

ret

2710

COPY_TO.VAR_DUMMY: ld a, (BASIC_VALTYP) ; create dummy variable from VALTYPE

2711

cp 3 ;

2712

jr nz, COPY_TO.VAR_DUMMY.DBL

2713

push hl

2714

call GET_STR.LENGTH ; get string length

2715

pop hl

2716

ld a, b ; string length

2717

COPY_TO.VAR_DUMMY.STR: call GET_VAR_DUMMY.ADDR ; create dummy string variable from HL

2718

ld (ix), 3 ; data type string

2719

ld (ix+1), 0 ;

2720

ld (ix+2), 255 ; var type fixed

2721

ld (ix+3), a ; string length

2722

ld (ix+4), l ; data address low

2723

ld (ix+5), h ; data address high

2724

;call GET_STR.LENGTH ; get string length

2725

;ld (ix+3), b ; string length

2726

push ix ; output var address...

2727

pop hl ; ...into hl

2728

ret ;

2729

COPY_TO.VAR_DUMMY.INT: call GET_VAR_DUMMY.ADDR ; create dummy integer variable from BC

2730

ld (ix), 2 ; data type string

2731

ld (ix+1), 0 ;

2732

ld (ix+2), 0 ;

2733

ld (ix+3), 0 ;

2734

ld (ix+4), 0 ;

2735

ld (ix+5), c ;

2736

ld (ix+6), b ;

2737

ld (ix+7), 0 ;

2738

ld (ix+8), 0 ;

2739

ld (ix+9), 0 ;

2740

ld (ix+10), 0 ;

2741

push ix ; output var address...

2742

pop hl ; ...into hl

2743

ret ;

2744

COPY_TO.VAR_DUMMY.DBL: call GET_VAR_DUMMY.ADDR ; create dummy value variable from DAC

2745

ld (ix), a ; data type

2746

ld (ix+1), 0 ;

2747

ld (ix+2), 0 ;

2748

ld bc, 8 ;

2749

ld hl, BASIC_DAC ;

2750

push ix ; just to copy ix to de

2751

pop de ;

2752

inc de ;

2753

inc de ;

2754

inc de ;

2755

ldir ; copy bc bytes from hl (data address) to de (variable address)

2756

push ix ; output var address...

2757

pop hl ; ...into hl

2758

ret ;

2759

GET_VAR_DUMMY.ADDR: push af ;

2760

push de

2761

ld de, 11 ;

2762

ld ix, (VAR_DUMMY.POINTER) ;

2763

ld a, (VAR_DUMMY.COUNTER) ;

2764

GET_VAR_DUMMY.NEXT: add ix, de ;

2765

inc a ;

2766

cp VAR_DUMMY.SIZE ;

2767

jr nz, GET_VAR_DUMMY.EXIT ;

2768

xor a ;

2769

ld ix, VAR_DUMMY.DATA ;

2770

GET_VAR_DUMMY.EXIT: ld (VAR_DUMMY.POINTER), ix ;

2771

ld (VAR_DUMMY.COUNTER), a ;

2772

ld a, (ix) ; get last var dummy type

2773

cp 3 ; is it string?

2774

call z, GET_VAR_DUMMY.FREE ; free string memory

2775

pop de

2776

pop af ;

2777

ret ;

2778

GET_VAR_DUMMY.FREE:

2779

push hl

2780

push ix

2781

ld l, (ix+4) ; get string data address

2782

ld h, (ix+5)

2783

push hl

2784

pop ix

2785

call memory.free ; free memory

2786

pop ix

2787

pop hl

2788

ret

2789

; input hl = variable address

2790

COPY_TO.DAC: ld de, BASIC_DAC

2791

COPY_TO.DAC.DATA: ld a, (hl)

2792

ld (BASIC_VALTYP), a

2793

inc hl

2794

inc hl

2795

inc hl

2796

ld bc, 8 ; data = 8 bytes

2797

ldir ; copy bc bytes from hl (data address) to de (variable address)

2798

ret

2799

COPY_TO.ARG: ld de, BASIC_ARG ;

2800

jr COPY_TO.DAC.DATA ;

2801

COPY_TO.DAC_ARG: ld hl, BASIC_DAC ;

2802

ld de, BASIC_ARG ;

2803

ld bc, 8 ; data = 8 bytes

2804

ldir ; copy bc bytes from hl (data address) to de (variable address)

2805

ret ;

2806

COPY_TO.ARG_DAC: ld hl, BASIC_ARG ;

2807

ld de, BASIC_DAC ;

2808

ld bc, 8 ; data = 8 bytes

2809

ldir ; copy bc bytes from hl (data address) to de (variable address)

2810

ret ;

2811

COPY_TO.DAC_TMP: ld hl, BASIC_DAC ;

2812

ld de, BASIC_SWPTMP ;

2813

ld bc, 8 ; data = 8 bytes

2814

ldir ; copy bc bytes from hl (data address) to de (variable address)

2815

ret ;

2816

COPY_TO.TMP_DAC: ld hl, BASIC_SWPTMP ;

2817

ld de, BASIC_DAC ;

2818

ld bc, 8 ; data = 8 bytes

2819

ldir ; copy bc bytes from hl (data address) to de (variable address)

2820

ret ;

2821

SWAP.DAC.ARG: di

2822

exx ; save registers

2823

ld bc, 8 ;

2824

ld hl, BASIC_DAC ;

2825

ld de, BASIC_SWPTMP ;

2826

ldir ; copy bc bytes from hl to de

2827

ld bc, 8 ;

2828

ld hl, BASIC_ARG ;

2829

ld de, BASIC_DAC ;

2830

ldir ; copy bc bytes from hl to de

2831

ld bc, 8 ;

2832

ld hl, BASIC_SWPTMP ;

2833

ld de, BASIC_ARG ;

2834

ldir ; copy bc bytes from hl to de

2835

exx ; restore registers

2836

2837

ret ;

2838

CLEAR.DAC: ld de, BASIC_DAC

2839

CLEAR.DAC.DATA: ld hl, BASIC_VALTYP

2840

ld (hl), 2

2841

ld hl, LIT_NULL_DBL

2842

ld bc, 8 ; data = 8 bytes

2843

ldir ; copy bc bytes from hl (data address) to de (variable address)

2844

ret

2845

CLEAR.ARG: ld de, BASIC_ARG

2846

jr CLEAR.DAC.DATA

2847

2848

2849

2850

2851

;---------------------------------------------------------------------------------------------------------

2852

; MATH 16 BITS ROUTINES

2853

;---------------------------------------------------------------------------------------------------------

2854

2855

MATH.PARM.POP: pop af ; get PC from caller stack

2856

ex af, af' ; save PC to temp

2857

pop.parm ; get first parameter

2858

call COPY_TO.ARG ; put HL in ARG (return var type in A)

2859

pop.parm ; get second parameter

2860

ex af, af' ; restore PC from temp

2861

push af ; put again PC from caller in stack

2862

ex af, af' ; restore 1st data type

2863

push af ; save 1st data type

2864

call COPY_TO.DAC ; put HL in DAC (return var type in A)

2865

pop bc ; restore 1st data type (ARG) in B

2866

cp b ; test if data type in A (DAC) = data type in B (ARG)

2867

ret z ; return if is equal data types

2868

MATH.PARM.CAST: push bc ; else cast both to double

2869

and 12 ; test if single/double

2870

jr nz, MATH.PARM.CST1 ; avoid cast if already single/double

2871

__call_bios MATH_FRCDBL ; convert DAC to double

2872

MATH.PARM.CST1: pop af ;

2873

and 12 ; test if single/double

2874

jr nz, MATH.PARM.CST2 ; avoid cast if already single/double

2875

ld (BASIC_VALTYP), a ;

2876

call COPY_TO.DAC_TMP ;

2877

call COPY_TO.ARG_DAC ;

2878

__call_bios MATH_FRCDBL ; convert ARG to double

2879

call COPY_TO.DAC_ARG ;

2880

call COPY_TO.TMP_DAC ;

2881

MATH.PARM.CST2: ld a, 8 ;

2882

ld (BASIC_VALTYP), a ;

2883

ret ;

2884

MATH.PARM.POP.INT: ; return result in DAC/ARG as integer

2885

pop af ; get PC from caller stack

2886

ex af, af' ; save PC to temp

2887

pop.parm ; get first parameter

2888

ld a, (hl) ; get parameter type

2889

and 2 ; test if integer

2890

jr z, MATH.PARM.POP.I1 ; do cast if not integer

2891

call COPY_TO.ARG ; put HL in ARG (return var type in A)

2892

jr MATH.PARM.POP.I2 ; go to next parameter

2893

MATH.PARM.POP.I1: call COPY_TO.DAC ; put HL in DAC (return var type in A)

2894

__call_bios MATH_FRCINT ; convert DAC to int

2895

call COPY_TO.DAC_ARG ; copy DAC to ARG

2896

MATH.PARM.POP.I2: pop.parm ; get second parameter

2897

call COPY_TO.DAC ; put HL in DAC (return var type in A)

2898

and 2 ; test if integer

2899

jr nz, MATH.PARM.POP.I3 ; avoid cast if already integer

2900

__call_bios MATH_FRCINT ; convert DAC to int

2901

ld a, 2 ;

2902

ld (BASIC_VALTYP), a ;

2903

MATH.PARM.POP.I3:

2904

ex af, af' ; restore PC from temp

2905

push af ; put again PC from caller in stack

2906

ret ;

2907

MATH.PARM.PUSH: call COPY_TO.VAR_DUMMY ;

2908

ret.parm ;

2909

2910

if defined MATH.ADD

2911

2912

; input DAC, ARG

2913

; output in parm stack

2914

; http://www.z80.info/zip/zaks_book.pdf - page 104

2915

MATH.ADD.INT: ld hl, (BASIC_DAC+2) ;

2916

ld bc, (BASIC_ARG+2) ;

2917

add hl, bc ;

2918

ld (BASIC_DAC+2), hl ;

2919

jp MATH.PARM.PUSH ;

2920

2921

endif

2922

2923

if defined MATH.SUB or defined MATH.NEG

2924

2925

; input DAC, ARG

2926

; output in parm stack

2927

; http://www.z80.info/zip/zaks_book.pdf - page 104

2928

MATH.SUB.INT: ld hl, (BASIC_DAC+2) ;

2929

ld de, (BASIC_ARG+2) ;

2930

and a ; clear carry

2931

sbc hl, de ;

2932

ld (BASIC_DAC+2), hl ;

2933

jp MATH.PARM.PUSH ;

2934

2935

endif

2936

2937

if defined MATH.MULT

2938

2939

; input DAC, ARG

2940

; output in parm stack

2941

MATH.MULT.INT: ld hl, (BASIC_DAC+2) ;

2942

ld bc, (BASIC_ARG+2) ;

2943

call MATH.MULT.16 ;

2944

ld (BASIC_DAC+2), hl ;

2945

jp MATH.PARM.PUSH ;

2946

2947

; input HL = multiplicand

2948

; input BC = multiplier

2949

; output HL = result

2950

; http://www.z80.info/zip/zaks_book.pdf - page 131

2951

MATH.MULT.16: ld a, c ; low multiplier

2952

ld c, b ; high multiplier

2953

ld b, 16

2954

ld d, h ; multiplicand

2955

ld e, l

2956

ld hl, 0

2957

MULT16LOOP: srl c ; right shift multiplier high

2958

rra ; rotate right multiplier low

2959

jr nc, MULT16NOADD ; test carry

2960

add hl, de ; add multiplicand to result

2961

MULT16NOADD: ex de, hl

2962

add hl, hl ; double - shift multiplicand

2963

ex de, hl

2964

djnz MULT16LOOP

2965

ret

2966

2967

endif

2968

2969

if defined MATH.DIV or defined MATH.IDIV or defined MATH.MOD

2970

2971

; input AC = dividend

2972

; input DE = divisor

2973

; output AC = quotient

2974

; output HL = remainder

2975

; http://www.z80.info/zip/zaks_book.pdf - page 140

2976

MATH.DIV.16: ld hl, 0 ; clear accumulator

2977

ld b, 16 ; set counter

2978

DIV16LOOP: rl c ; rotate accumulator result left

2979

rla

2980

adc hl, hl ; left shift

2981

sbc hl, de ; trial subtract divisor

2982

jr nc, $ + 3 ; subtract was OK ($ = current location)

2983

add hl, de ; restore accumulator

2984

ccf ; calculate result bit

2985

djnz DIV16LOOP ; counter not zero

2986

rl c ; shift in last result bit

2987

rla

2988

ret

2989

2990

endif

2991

2992

if defined GFX_FAST or defined LINE

2993

2994

; compare two signed 16 bits integers

2995

; HL < DE: Carry flag

2996

; HL = DE: Zero flag

2997

; http://www.z80.info/zip/zaks_book.pdf - page 531

2998

MATH.COMP.S16: ld a, h ; test high order byte

2999

and 0x80 ; test sign, clear carry

3000

jr nz, MATH.COMP.S16.NEGM1 ; jump if hl is negative

3001

bit 7, d

3002

ret nz ; de is negative (and hl is positive)

3003

ld a, h

3004

cp d ; signs are both positive, so normal compare

3005

ret nz

3006

ld a, l ; test low order byte

3007

cp e

3008

ret

3009

MATH.COMP.S16.NEGM1:

3010

xor d

3011

rla ; sign bit into carry

3012

ret c ; signs different

3013

ld a, h

3014

cp d ; both signs negative

3015

ret nz

3016

ld a, l

3017

cp e

3018

ret

3019

3020

endif

3021

3022

if defined MATH.ADD

3023

3024

MATH.ADD.SGL: ld a, 8 ;

3025

ld (BASIC_VALTYP), a ;

3026

MATH.ADD.DBL: __call_bios MATH_DECADD ;

3027

jp MATH.PARM.PUSH ;

3028

3029

endif

3030

3031

if defined MATH.SUB or defined MATH.NEG

3032

3033

MATH.SUB.SGL: ld a, 8 ;

3034

ld (BASIC_VALTYP), a ;

3035

MATH.SUB.DBL: __call_bios MATH_DECSUB ;

3036

jp MATH.PARM.PUSH ;

3037

3038

endif

3039

3040

if defined MATH.MULT

3041

3042

MATH.MULT.SGL: ld a, 8 ;

3043

ld (BASIC_VALTYP), a ;

3044

MATH.MULT.DBL: __call_bios MATH_DECMUL ;

3045

jp MATH.PARM.PUSH ;

3046

3047

endif

3048

3049

if defined MATH.DIV

3050

3051

; input DAC, ARG

3052

; output in parm stack

3053

MATH.DIV.INT: __call_bios MATH_FRCDBL ; convert DAC to double

3054

call SWAP.DAC.ARG ;

3055

ld a, 2 ;

3056

ld (BASIC_VALTYP), a ;

3057

__call_bios MATH_FRCDBL ; convert ARG to double

3058

call SWAP.DAC.ARG ;

3059

MATH.DIV.SGL: ld a, 8 ;

3060

ld (BASIC_VALTYP), a ;

3061

MATH.DIV.DBL: __call_bios MATH_DECDIV ;

3062

jp MATH.PARM.PUSH ;

3063

3064

endif

3065

3066

if defined MATH.IDIV

3067

3068

; input DAC, ARG

3069

; output in parm stack

3070

MATH.IDIV.SGL: ld a, 8 ;

3071

ld (BASIC_VALTYP), a ;

3072

MATH.IDIV.DBL: __call_bios MATH_FRCINT ; convert DAC to integer

3073

call SWAP.DAC.ARG ;

3074

ld a, 8 ;

3075

ld (BASIC_VALTYP), a ;

3076

__call_bios MATH_FRCINT ; convert ARG to integer

3077

call SWAP.DAC.ARG ;

3078

MATH.IDIV.INT: ld hl, (BASIC_DAC+2) ;

3079

ld a, h ;

3080

ld c, l ;

3081

ld de, (BASIC_ARG+2) ;

3082

call MATH.DIV.16 ;

3083

ld h, a ;

3084

ld l, c ;

3085

ld (BASIC_DAC+2), hl ; quotient

3086

jp MATH.PARM.PUSH ;

3087

3088

endif

3089

3090

if defined MATH.POW

3091

3092

MATH.POW.INT: ld (BASIC_VALTYP), a ;

3093

__call_bios MATH_FRCDBL ; convert DAC to double

3094

call SWAP.DAC.ARG ;

3095

ld a, 2 ;

3096

ld (BASIC_VALTYP), a ;

3097

__call_bios MATH_FRCDBL ; convert ARG to double

3098

call SWAP.DAC.ARG ;

3099

MATH.POW.SGL: ld a, 8 ;

3100

ld (BASIC_VALTYP), a ;

3101

MATH.POW.DBL: __call_bios MATH_DBLEXP ;

3102

jp MATH.PARM.PUSH ;

3103

3104

endif

3105

3106

if defined MATH.MOD

3107

3108

;MATH.MOD.SGL: ld a, 8 ;

3109

; ld (BASIC_VALTYP), a ;

3110

;MATH.MOD.DBL: __call_bios MATH_FRCINT ; convert DAC to integer

3111

; call SWAP.DAC.ARG ;

3112

; ld a, 8 ;

3113

; ld (BASIC_VALTYP), a ;

3114

; __call_bios MATH_FRCINT ; convert ARG to integer

3115

; call SWAP.DAC.ARG ;

3116

MATH.MOD.INT: ld hl, (BASIC_DAC+2) ;

3117

ld a, h ;

3118

ld c, l ;

3119

ld de, (BASIC_ARG+2) ;

3120

call MATH.DIV.16 ;

3121

ld (BASIC_DAC+2), hl ; remainder

3122

jp MATH.PARM.PUSH ;

3123

3124

endif

3125

3126

if defined ISQR

3127

3128

; fast 16-bit integer square root

3129

; http://www.retroprogramming.com/2017/07/a-fast-z80-integer-square-root.html

3130

; 92 bytes, 344-379 cycles (average 362)

3131

; v2 - 3 t-state optimization spotted by Russ McNulty

3132

; call with hl = number to square root

3133

; returns a = square root

3134

; corrupts hl, de

3135

3136

MATH.INT.SQR:

3137

ld a,h

3138

ld de,0B0C0h

3139

add a,e

3140

jr c,sq7

3141

ld a,h

3142

ld d,0F0h

3143

sq7:

3144

add a,d

3145

jr nc,sq6

3146

res 5,d

3147

db 254

3148

sq6:

3149

sub d

3150

sra d

3151

set 2,d

3152

add a,d

3153

jr nc,sq5

3154

res 3,d

3155

db 254

3156

sq5:

3157

sub d

3158

sra d

3159

inc d

3160

add a,d

3161

jr nc,sq4

3162

res 1,d

3163

db 254

3164

sq4:

3165

sub d

3166

sra d

3167

ld h,a

3168

add hl,de

3169

jr nc,sq3

3170

ld e,040h

3171

db 210

3172

sq3:

3173

sbc hl,de

3174

sra d

3175

ld a,e

3176

rra

3177

or 010h

3178

ld e,a

3179

add hl,de

3180

jr nc,sq2

3181

and 0DFh

3182

db 218

3183

sq2:

3184

sbc hl,de

3185

sra d

3186

rra

3187

or 04h

3188

ld e,a

3189

add hl,de

3190

jr nc,sq1

3191

and 0F7h

3192

db 218

3193

sq1:

3194

sbc hl,de

3195

sra d

3196

rra

3197

inc a

3198

ld e,a

3199

add hl,de

3200

jr nc,sq0

3201

and 0FDh

3202

sq0:

3203

sra d

3204

rra

3205

cpl

3206

ret

3207

3208

endif

3209

3210

if defined RANDOMIZE or defined SEED

3211

3212

MATH.RANDOMIZE: di ;

3213

ld bc, (BIOS_JIFFY) ;

3214

ei ;

3215

3216

MATH.SEED: ld (BASIC_RNDX), bc ; seed to IRND

3217

push bc ; in bc = new integer seed

3218

call CLEAR.DAC ;

3219

pop bc ;

3220

;ld ix, BASIC_DAC ;

3221

ld (BASIC_DAC+2), bc ; copy bc to dac

3222

ld a, 2 ; type integer

3223

ld (BASIC_VALTYP), a ;

3224

__call_bios MATH_FRCDBL ; convert DAC integer to DAC double

3225

__call_bios MATH_NEG ; DAC = -DAC

3226

__call_bios MATH_RND ; put in DAC a new random number from previous DAC parameter

3227

ret ;

3228

3229

endif

3230

3231

MATH.ERROR: ld e, 13 ; type mismatch

3232

__call_basic BASIC_ERROR_HANDLER ;

3233

ret

3234

3235

3236

;---------------------------------------------------------------------------------------------------------

3237

; BOOLEAN ROUTINES

3238

;---------------------------------------------------------------------------------------------------------

3239

3240

BOOLEAN.RET.TRUE: ld hl, LIT_TRUE ;

3241

ret.parm ;

3242

BOOLEAN.RET.FALSE: ld hl, LIT_FALSE ;

3243

ret.parm ;

3244

BOOLEAN.CMP.INT: ld hl, (BASIC_DAC+2) ;

3245

ld de, (BASIC_ARG+2) ;

3246

__call_bios MATH_ICOMP ;

3247

ret ;

3248

BOOLEAN.CMP.SGL: ld bc, (BASIC_ARG) ;

3249

ld de, (BASIC_ARG+2) ;

3250

__call_bios MATH_DCOMP ;

3251

ret ;

3252

BOOLEAN.CMP.DBL: __call_bios MATH_XDCOMP ;

3253

ret ;

3254

BOOLEAN.CMP.STR: call STRING.COMPARE ;

3255

ret ;

3256

3257

if defined BOOLEAN.GT

3258

3259

BOOLEAN.GT.INT: call BOOLEAN.CMP.INT ;

3260

jr BOOLEAN.GT.RET ;

3261

BOOLEAN.GT.STR: call BOOLEAN.CMP.STR ;

3262

jr BOOLEAN.GT.RET ;

3263

BOOLEAN.GT.SGL: call BOOLEAN.CMP.SGL ;

3264

jr BOOLEAN.GT.RET ;

3265

BOOLEAN.GT.DBL: call BOOLEAN.CMP.DBL ;

3266

jr BOOLEAN.GT.RET ;

3267

BOOLEAN.GT.RET: cp 0x01 ;

3268

jp z, BOOLEAN.RET.TRUE ;

3269

jp BOOLEAN.RET.FALSE ;

3270

endif

3271

3272

if defined BOOLEAN.LT

3273

3274

BOOLEAN.LT.INT: call BOOLEAN.CMP.INT ;

3275

jr BOOLEAN.LT.RET ;

3276

BOOLEAN.LT.STR: call BOOLEAN.CMP.STR ;

3277

jr BOOLEAN.LT.RET ;

3278

BOOLEAN.LT.SGL: call BOOLEAN.CMP.SGL ;

3279

jr BOOLEAN.LT.RET ;

3280

BOOLEAN.LT.DBL: call BOOLEAN.CMP.DBL ;

3281

jr BOOLEAN.LT.RET ;

3282

BOOLEAN.LT.RET: cp 0xFF ;

3283

jp z, BOOLEAN.RET.TRUE ;

3284

jp BOOLEAN.RET.FALSE ;

3285

3286

endif

3287

3288

if defined BOOLEAN.GE

3289

3290

BOOLEAN.GE.INT: call BOOLEAN.CMP.INT ;

3291

jr BOOLEAN.GE.RET ;

3292

BOOLEAN.GE.STR: call BOOLEAN.CMP.STR ;

3293

jr BOOLEAN.GE.RET ;

3294

BOOLEAN.GE.SGL: call BOOLEAN.CMP.SGL ;

3295

jr BOOLEAN.GE.RET ;

3296

BOOLEAN.GE.DBL: call BOOLEAN.CMP.DBL ;

3297

jr BOOLEAN.GE.RET ;

3298

BOOLEAN.GE.RET: cp 0x01 ;

3299

jp z, BOOLEAN.RET.TRUE ;

3300

or a ; cp 0

3301

jp z, BOOLEAN.RET.TRUE ;

3302

jp BOOLEAN.RET.FALSE ;

3303

3304

endif

3305

3306

if defined BOOLEAN.LE

3307

3308

BOOLEAN.LE.INT: call BOOLEAN.CMP.INT ;

3309

jr BOOLEAN.LE.RET ;

3310

BOOLEAN.LE.STR: call BOOLEAN.CMP.STR ;

3311

jr BOOLEAN.LE.RET ;

3312

BOOLEAN.LE.SGL: call BOOLEAN.CMP.SGL ;

3313

jr BOOLEAN.LE.RET ;

3314

BOOLEAN.LE.DBL: call BOOLEAN.CMP.DBL ;

3315

jr BOOLEAN.LE.RET ;

3316

BOOLEAN.LE.RET: cp 0xFF ;

3317

jp z, BOOLEAN.RET.TRUE ;

3318

or a ; cp 0

3319

jp z, BOOLEAN.RET.TRUE ;

3320

jp BOOLEAN.RET.FALSE ;

3321

3322

endif

3323

3324

if defined BOOLEAN.NE

3325

3326

BOOLEAN.NE.INT: call BOOLEAN.CMP.INT ;

3327

jr BOOLEAN.NE.RET ;

3328

BOOLEAN.NE.STR: call BOOLEAN.CMP.STR ;

3329

jr BOOLEAN.NE.RET ;

3330

BOOLEAN.NE.SGL: call BOOLEAN.CMP.SGL ;

3331

jr BOOLEAN.NE.RET ;

3332

BOOLEAN.NE.DBL: call BOOLEAN.CMP.DBL ;

3333

jr BOOLEAN.NE.RET ;

3334

BOOLEAN.NE.RET: or a ; cp 0

3335

jp nz, BOOLEAN.RET.TRUE ;

3336

jp BOOLEAN.RET.FALSE ;

3337

3338

endif

3339

3340

if defined BOOLEAN.EQ

3341

3342

BOOLEAN.EQ.INT: call BOOLEAN.CMP.INT ;

3343

jr BOOLEAN.EQ.RET ;

3344

BOOLEAN.EQ.STR: call BOOLEAN.CMP.STR ;

3345

jr BOOLEAN.EQ.RET ;

3346

BOOLEAN.EQ.SGL: call BOOLEAN.CMP.SGL ;

3347

jr BOOLEAN.EQ.RET ;

3348

BOOLEAN.EQ.DBL: call BOOLEAN.CMP.DBL ;

3349

jr BOOLEAN.EQ.RET ;

3350

BOOLEAN.EQ.RET: or a ; cp 0

3351

jp z, BOOLEAN.RET.TRUE ;

3352

jp BOOLEAN.RET.FALSE ;

3353

3354

endif

3355

3356

if defined BOOLEAN.AND

3357

3358

BOOLEAN.AND.INT: ld a, (BASIC_DAC+2) ;

3359

ld hl, BASIC_ARG+2 ;

3360

and (hl) ;

3361

ld (BASIC_DAC+2), a ;

3362

inc hl ;

3363

ld a, (BASIC_DAC+3) ;

3364

and (hl) ;

3365

ld (BASIC_DAC+3), a ;

3366

ld a, 2 ;

3367

jp MATH.PARM.PUSH ;

3368

3369

endif

3370

3371

if defined BOOLEAN.OR

3372

3373

BOOLEAN.OR.INT: ld a, (BASIC_DAC+2) ;

3374

ld hl, BASIC_ARG+2 ;

3375

or (hl) ;

3376

ld (BASIC_DAC+2), a ;

3377

inc hl ;

3378

ld a, (BASIC_DAC+3) ;

3379

or (hl) ;

3380

ld (BASIC_DAC+3), a ;

3381

ld a, 2 ;

3382

jp MATH.PARM.PUSH ;

3383

3384

endif

3385

3386

if defined BOOLEAN.XOR

3387

3388

BOOLEAN.XOR.INT: ld a, (BASIC_DAC+2) ;

3389

ld hl, BASIC_ARG+2 ;

3390

xor (hl) ;

3391

ld (BASIC_DAC+2), a ;

3392

inc hl ;

3393

ld a, (BASIC_DAC+3) ;

3394

xor (hl) ;

3395

ld (BASIC_DAC+3), a ;

3396

ld a, 2 ;

3397

jp MATH.PARM.PUSH ;

3398

3399

endif

3400

3401

if defined BOOLEAN.EQV

3402

3403

BOOLEAN.EQV.INT: ld a, (BASIC_DAC+2) ;

3404

ld hl, BASIC_ARG+2 ;

3405

xor (hl) ;

3406

cpl ;

3407

ld (BASIC_DAC+2), a ;

3408

inc hl ;

3409

ld a, (BASIC_DAC+3) ;

3410

xor (hl) ;

3411

cpl ;

3412

ld (BASIC_DAC+3), a ;

3413

ld a, 2 ;

3414

jp MATH.PARM.PUSH ;

3415

3416

endif

3417

3418

if defined BOOLEAN.IMP

3419

3420

BOOLEAN.IMP.INT: ld a, (BASIC_DAC+2) ;

3421

ld hl, BASIC_ARG+2 ;

3422

cpl ;

3423

or (hl) ;

3424

ld (BASIC_DAC+2), a ;

3425

inc hl ;

3426

ld a, (BASIC_DAC+3) ;

3427

cpl ;

3428

or (hl) ;

3429

ld (BASIC_DAC+3), a ;

3430

ld a, 2 ;

3431

jp MATH.PARM.PUSH ;

3432

3433

endif

3434

3435

if defined BOOLEAN.SHR

3436

3437

BOOLEAN.SHR.INT: ld ix, BASIC_DAC+2 ; shift DAC integer to right (bits 15...0-->)

3438

ld a, (BASIC_ARG+2) ;

3439

or a ; clear carry

3440

jp z, MATH.PARM.PUSH ; return if not shift

3441

ld b, a ; shift count

3442

BOOLEAN.SHR.INT.N: rr (ix+1) ;

3443

rr (ix) ;

3444

or a ; clear carry

3445

djnz BOOLEAN.SHR.INT.N ; next shift

3446

ld a, 2 ;

3447

jp MATH.PARM.PUSH ; return DAC

3448

3449

endif

3450

3451

if defined BOOLEAN.SHL

3452

3453

BOOLEAN.SHL.INT: ld ix, BASIC_DAC+2 ; shift DAC integer to left (<--bits 15...0)

3454

ld a, (BASIC_ARG+2) ;

3455

or a ; clear carry

3456

jp z, MATH.PARM.PUSH ; return if not shift

3457

ld b, a ; shift count

3458

BOOLEAN.SHL.INT.N: rl (ix) ;

3459

rl (ix+1) ;

3460

or a ; clear carry

3461

djnz BOOLEAN.SHL.INT.N ; next shift

3462

ld a, 2 ;

3463

jp MATH.PARM.PUSH ; return DAC

3464

3465

endif

3466

3467

if defined BOOLEAN.NOT

3468

3469

BOOLEAN.NOT.INT: ld a, (BASIC_DAC+2) ;

3470

cpl ;

3471

ld (BASIC_DAC+2), a ;

3472

ld a, (BASIC_DAC+3) ;

3473

cpl ;

3474

ld (BASIC_DAC+3), a ;

3475

ld a, 2 ;

3476

jp MATH.PARM.PUSH ;

3477

3478

endif

3479

3480

3481

3482

3483

;---------------------------------------------------------------------------------------------------------

3484

; MEMORY ALLOCATION ROUTINES

3485

;---------------------------------------------------------------------------------------------------------

3486

; Adapted from memory allocator code by SamSaga2, Spain, 2015

3487

; https://www.msx.org/forum/msx-talk/development/asm-memory-allocator

3488

; https://www.msx.org/users/samsaga2

3489

;---------------------------------------------------------------------------------------------------------

3490

memory.heap_start: equ VAR_STACK.END + 1 ; start at end of variable stack

3491

memory.heap_end: equ 0xF0A0 - 100 ; end at start of work area for stack (100 bytes reserved), BIOS and BASIC interpreter

3492

block.next: equ 0 ; next free block address

3493

block.size: equ 2 ; size of block including header

3494

block: equ 4 ; block.next + block.size

3495

3496

;; init

3497

memory.init:

3498

ld ix,memory.heap_start ; first block

3499

ld hl,memory.heap_start+block ; second block

3500

;; first block NEXT=secondblock, SIZE=0

3501

;; with this block we have a fixed start location

3502

;; because never will be allocated

3503

ld (ix+block.next),l

3504

ld (ix+block.next+1),h

3505

ld (ix+block.size),0

3506

ld (ix+block.size+1),0

3507

;; second block NEXT=0, SIZE=all

3508

;; the first and only free block have all available memory

3509

ld (ix+block.next+block),0

3510

ld (ix+block.next+block+1),0

3511

xor a

3512

;ld hl,memory.heap_end ; size = @heap_end (stack) - heap_start - block_header * 2 - 100 (buffer for stack)

3513

ld (BIOS_TEMP), sp

3514

ld hl, (BIOS_TEMP)

3515

ld de, memory.heap_start + (block * 2) + 100

3516

sbc hl,de

3517

;ld de, block * 2 + 100

3518

;sbc hl, de

3519

ld (ix+block.size+block),l

3520

ld (ix+block.size+block+1),h

3521

ret

3522

3523

;; alloc

3524

;; IN BC=size, OUT IX=memptr, NZ=ok

3525

memory.alloc:

3526

ld hl,block

3527

add hl,bc

3528

;push hl

3529

;pop bc

3530

ld b, h

3531

ld c, l

3532

ld ix,memory.heap_start ; this

3533

ld iy,0 ; prev

3534

memory.alloc.find:

3535

ld l,(ix+block.size)

3536

ld h,(ix+block.size+1)

3537

xor a

3538

sbc hl,bc

3539

jp z, memory.alloc.exactfit

3540

jp c, memory.alloc.nextblock

3541

;; split found block

3542

memory.alloc.splitfit:

3543

;; free space must allow at least two blocks headers (current + next)

3544

or h

3545

jr nz, memory.alloc.splitfit.do ; if free space > 0xFF, do split

3546

ld a, l

3547

cp 4

3548

jr c, memory.alloc.nextblock ; if free space < 4, skip to next block

3549

memory.alloc.splitfit.do:

3550

;; newfreeblock = this + BC

3551

push ix

3552

pop hl

3553

add hl,bc

3554

;; prevblock->next = newfreeblock

3555

ld (iy+block.next),l

3556

ld (iy+block.next+1),h

3557

;; newfreeblock->next = this->next

3558

push hl

3559

pop iy ; iy = newfreeblock

3560

ld l,(ix+block.next)

3561

ld h,(ix+block.next+1)

3562

ld (iy+block.next),l

3563

ld (iy+block.next+1),h

3564

;; newfreeblock->size = this->size - BC

3565

ld l,(ix+block.size)

3566

ld h,(ix+block.size+1)

3567

xor a

3568

sbc hl,bc

3569

ld (iy+block.size),l

3570

ld (iy+block.size+1),h

3571

;; this->size = BC

3572

ld (ix+block.size),c

3573

ld (ix+block.size+1),b

3574

jr memory.alloc.ok

3575

;; use whole found block

3576

memory.alloc.exactfit:

3577

;; prevblock->next = this->next - remove block from free list

3578

ld l,(ix+block.next)

3579

ld h,(ix+block.next+1)

3580

ld (iy+block.next),l

3581

ld (iy+block.next+1),h

3582

memory.alloc.ok:

3583

;; ix = first byte

3584

ld de,block

3585

add ix,de

3586

;; enable z-flag

3587

ld a,1

3588

or a

3589

ret

3590

memory.alloc.nextblock:

3591

ld l,(ix+block.next)

3592

ld h,(ix+block.next+1)

3593

ld a,l

3594

cp h

3595

ret z

3596

;; prevblock = this

3597

push ix

3598

pop iy

3599

;; this = this->next

3600

push hl

3601

pop ix

3602

jp memory.alloc.find

3603

3604

;; free

3605

;; IN IX=memptr

3606

memory.free:

3607

;; HL = IX - block_header_size

3608

push ix

3609

pop hl

3610

ld de, block

3611

xor a

3612

sbc hl,de

3613

;; start of search

3614

ld ix,memory.heap_start

3615

memory.free.find:

3616

ld e,(ix+block.next)

3617

ld d,(ix+block.next+1)

3618

ld a,d

3619

or e

3620

jp z, memory.free.passedend

3621

sbc hl,de ; test this (HL) against next (DE)

3622

jr c, memory.free.found ; if DE > HL

3623

add hl,de ; restore hl value

3624

push de

3625

pop ix ; current = next

3626

jr memory.free.find

3627

3628

;; ix=prev, hl=this, de=next

3629

memory.free.found:

3630

add hl,de ; restore hl value

3631

ld (ix+block.next), l

3632

ld (ix+block.next+1), h ; prev->next = this

3633

push hl

3634

pop iy

3635

ld (iy+block.next), e

3636

ld (iy+block.next+1), d ; this->next = next

3637

push ix ; prev x this

3638

pop iy

3639

push hl

3640

pop ix

3641

push de

3642

call memory.free.coalesce

3643

pop ix ; this x next

3644

jr memory.free.coalesce

3645

3646

;; parm1 = *next

3647

;; parm2 = *this

3648

memory.free.coalesce:

3649

ld c, (iy+block.size)

3650

ld b, (iy+block.size+1) ; bc = this->size

3651

push iy

3652

pop hl

3653

xor a

3654

adc hl, bc ; hl = this + this->size

3655

push ix

3656

pop de

3657

xor a

3658

sbc hl, de ; if this + this->size == next, then this->size += next->size, this->next = next->next

3659

jr z, memory.free.coalesce.do

3660

push ix ; else, new *this = *next

3661

pop iy

3662

ret

3663

memory.free.coalesce.do:

3664

ld l, (ix+block.size)

3665

ld h, (ix+block.size+1) ; hl = next->size

3666

xor a

3667

adc hl, bc ; hl += this->size

3668

ld (iy+block.size), l

3669

ld (iy+block.size+1), h ; this->size = hl

3670

ld l, (ix+block.next)

3671

ld h, (ix+block.next+1) ; hl = next->next

3672

ld (iy+block.next), l

3673

ld (iy+block.next+1), h ; this->next = hl

3674

ret

3675

3676

memory.free.passedend:

3677

;; append block at the end of the free list

3678

ld (ix+block.next),l

3679

ld (ix+block.next+1),h

3680

push hl

3681

pop iy

3682

ld (iy+block.next),0

3683

ld (iy+block.next+1),0

3684

ret

3685

3686

;; get_free

3687

;; OUT BC=freespace

3688

memory.get_free:

3689

ld ix,memory.heap_start

3690

ld bc,0

3691

memory.get_free.count:

3692

ld a,c

3693

add a,(ix+block.size)

3694

ld c,a

3695

ld a,b

3696

adc a,(ix+block.size+1)

3697

ld b,a

3698

ld l,(ix+block.next)

3699

ld h,(ix+block.next+1)

3700

ld a,h

3701

or l

3702

ret z

3703

push hl

3704

pop ix

3705

jr memory.get_free.count

3706

3707

memory.error: ld e, 7 ; out of memory

3708

__call_basic BASIC_ERROR_HANDLER ;

3709

ret

3710

3711

3712

3713

3714

3715

;---------------------------------------------------------------------------------------------------------

3716

; GRAPHICS LIBRARY

3717

; By: Amaury Carvalho, 2019

3718

;---------------------------------------------------------------------------------------------------------

3719

; References:

3720

; https://en.wikipedia.org/wiki/Bresenham%27s_line_algorithm#Algorithm_for_integer_arithmetic

3721

; https://en.wikipedia.org/wiki/Midpoint_circle_algorithm

3722

; https://rosettacode.org/wiki/Bitmap/Midpoint_circle_algorithm#C

3723

; https://www.msx.org/wiki/MSX-BASIC_Instructions

3724

;---------------------------------------------------------------------------------------------------------

3725

3726

;---------------------------------------------------------------------------------------------------------

3727

; Bios functions

3728

;---------------------------------------------------------------------------------------------------------

3729

3730

BIOS_WRTVDP: EQU 0x0047

3731

BIOS_RDVRM: EQU 0x004A

3732

BIOS_WRTVRM: EQU 0x004D

3733

BIOS_LDIRVM: EQU 0x005C

3734

BIOS_LDIRMV: EQU 0x0059

3735

BIOS_PNTINI: EQU 0x18CF

3736

BIOS_RIGHTC: EQU 0x16C5 ; Move current pixel physical address right

3737

BIOS_TRIGHTC: EQU 0x16AC ; Test then RIGHTC if legal

3738

BIOS_LEFTC: EQU 0x16EE ; Move current pixel physical address left

3739

BIOS_TLEFTC: EQU 0x16D8 ; Test then LEFTC if legal

3740

BIOS_UPC: EQU 0x175D ; Move current pixel physical address up

3741

BIOS_TUPC: EQU 0x173C ; Test then UPC if legal

3742

BIOS_DOWNC: EQU 0x172A ; Move current pixel physical address down

3743

BIOS_TDOWNC: EQU 0x170A ; Test then DOWNC if legal

3744

BIOS_DCOMPR: EQU 0x146A ; compare HL and DE (Flag NC if HL>DE, Flag Z if HL=DE, Flag C if HL<DE)

3745

BIOS_FILVRM: EQU 0x0056 ; fill VRAM with value

3746

3747

BIOS_BIGFIL: EQU 0x016B ; msx 2

3748

BIOS_NRDVRM: EQU 0x0174 ; msx 2

3749

BIOS_NWRVRM: EQU 0x0177 ; msx 2

3750

BIOS_NRDVDP: EQU 0x013E ; msx 2

3751

BIOS_VDPSTA: EQU 0x0131 ; msx 2

3752

BIOS_NWRVDP: EQU 0x012D ; msx 2 (0x0647)

3753

3754

BASIC_SUB_LINE: equ 0x58fc

3755

BASIC_SUB_LINEBOX: equ 0x5912

3756

BASIC_SUB_LINEBOXFILLED: equ 0x58C1

3757

BASIC_SUB_CIRCLE: equ 0x5B19

3758

BASIC_SUB_PAINT1: equ 0x59DA ;0x59C8

3759

BASIC_SUB_PAINT2: equ 0x0069 ;0x2664 ;0x2651+3

3760

3761

;---------------------------------------------------------------------------------------------------------

3762

; Work areas

3763

;---------------------------------------------------------------------------------------------------------

3764

3765

BIOS_RG0SAV: EQU 0xF3DF

3766

BIOS_RG1SAV: EQU 0xF3E0

3767

BIOS_RG8SAV: EQU 0xFFE7

3768

BIOS_BDRATR: EQU 0xFCB2

3769

BIOS_STATFL: EQU 0xF3E7 ; VDP status register

3770

3771

BIOS_CXOFF: EQU 0xF945

3772

BIOS_CYOFF: EQU 0xF947

3773

BIOS_GXPOS: EQU 0xFCB3

3774

BIOS_GYPOS: EQU 0xFCB5

3775

3776

BIOS_GRPNAM: EQU 0xF3C7 ; pattern name table

3777

BIOS_GRPCOL: EQU 0xF3C9 ; colour table

3778

BIOS_GRPCGP: EQU 0xF3CB ; pattern generator table

3779

BIOS_GRPATR: EQU 0xF3CD ; sprite attribute table

3780

BIOS_GRPPAT: EQU 0xF3CF ; sprite generator table

3781

BIOS_CGPNT: EQU 0xF920 ; 2 - current MSX Font location (0x1BBF)

3782

BIOS_ATRBAS: EQU 0xF928 ; sprite attribute table

3783

3784

BIOS_MLTNAM: EQU 0xF3D1 ; pattern name table (screen 3, multicolor)

3785

BIOS_MLTCOL: EQU 0xF3D3 ; colour table (screen 3, multicolor)

3786

BIOS_MLTCGP: EQU 0xF3D5 ; pattern generator table (screen 3, multicolor)

3787

BIOS_MLTATR: EQU 0xF3D7 ; sprite attribute table (screen 3, multicolor)

3788

BIOS_MLTPAT: EQU 0xF3D9 ; sprite generator table (screen 3, multicolor)

3789

3790

BIOS_ASPECT: equ 0xF931 ;2 Aspect ratio of the circle; set by <ratio> of CIRCLE.

3791

BIOS_CENCNT: equ 0xF933 ;2 Counter used by CIRCLE.

3792

BIOS_CLINEF: equ 0xF935 ;1 Flag to draw line to centre, Used set by CIRCLE

3793

BIOS_CNPNTS: equ 0xF936 ;2 Point to be plottted in a 45° segment, Used set by CIRCLE

3794

BIOS_CPLOTF: equ 0xF938 ;1 Plot polarity flag, Used set by CIRCLE

3795

BIOS_CPCNT: equ 0xF939 ;2 Number of points in 1/8 of circle, Used set by CIRCLE.

3796

BIOS_CPCNT8: equ 0xF93B ;2 Number of points in the circle. Used by CIRCLE.

3797

BIOS_CRCSUM: equ 0xF93D ;2 Cyclic redundancy check sum of the circle. Used by CIRCLE.

3798

BIOS_CSTCNT: equ 0xF93F ;2 Variable to maintain the number of points of the starting angle. Used by the instruction CIRCLE

3799

BIOS_CSCLXY: equ 0xF941 ;1 Scale of X & Y. Used by the instruction CIRCLE

3800

BIOS_ASPCT1: equ 0xF40B ;2 256/aspect ratio for Basic instruction CIRCLE.

3801

BIOS_ASPCT2: equ 0xF40D ;2 256*aspect ratio for Basic instruction CIRCLE.

3802

BIOS_MAXUPD: equ 0xF3EC ;3 Work area used by the instruction CIRCLE, contains JP 0000h at start.

3803

BIOS_MINUPD: equ 0xF3EF ;3 Work area used by the instruction CIRCLE, contains JP 0000h at start.

3804

3805

BIOS_PARM1: EQU 0xF6E8 ; 100

3806

BIOS_PARM2: EQU 0xF750 ; 100

3807

3808

GFX_TEMP: EQU BIOS_PARM1 ; 2

3809

GFX_TEMP1: EQU GFX_TEMP + 2 ; 2

3810

GFX_TEMP2: EQU GFX_TEMP1 + 2 ; 2

3811

GFX_TEMP3: EQU GFX_TEMP2 + 2 ; 2

3812

GFX_TEMP4: EQU GFX_TEMP3 + 2 ; 2

3813

GFX_TEMP5: EQU GFX_TEMP4 + 2 ; 2

3814

GFX_TEMP6: EQU GFX_TEMP5 + 2 ; 2

3815

GFX_TEMP7: EQU GFX_TEMP6 + 2 ; 2

3816

GFX_TEMP8: EQU GFX_TEMP7 + 2 ; 2

3817

GFX_TEMP9: EQU GFX_TEMP8 + 2 ; 2

3818

3819

GFX_MAX_X: EQU 0xFCA4 ; 1 (CASSETE LOWLIM)

3820

GFX_MAX_Y: EQU 0xFCA5 ; 1 (CASSETE WINWID)

3821

3822

GFX_SPRITE_FLAGS: EQU 0xF40A ; 1 (CASSETE HEADER) - bits 0=check screen limits, 1=check walls, 2=check hotspots,

3823

; 3=limit touched, 4=wall touched, 5=hotspot touched, 6=collided

3824

GFX_SPRITE_SIZE_DAT: EQU 0xF3FC ; 1 (CASSETE CS1200)

3825

GFX_SPRITE_SIZE_SCR: EQU 0xF3FD ; 1

3826

GFX_SPRITE_WALLS: EQU 0xF406 ; 2 (CASSETE LOW)

3827

GFX_SPRITE_HOTSPOTS: EQU 0xF408 ; 2 (CASSETE HIGH)

3828

GFX_SPRITE_HOTSPOT_TILE: EQU 0xF405 ; 1 (CASSETE CS2400)

3829

GFX_SPRITE_COLLIDER: EQU 0xF400 ; 1 (CASSETE CS1200)

3830

GFX_SPRITE_COLLISION: EQU 0xF7B5 ; 2 (ARYTA2)

3831

3832

GFX_MUSIC_START: EQU 0xF401 ; 2 (CASSETE CS2400)

3833

GFX_MUSIC_NEXT: EQU 0xF403 ; 2

3834

GFX_MUSIC_PREV: EQU 0xF74C ; 2 (PRMPRV)

3835

3836

GFX_TEMP10: EQU 0xF3FE ; 2 (CASSETE CS1200)

3837

3838

;BIOS_SCR_SIZE_X: dw 240, 256, 256, 64, 256, 256, 512, 512, 256, 512, 256, 256, 256

3839

;BIOS_SCR_SIZE_Y: dw 192, 192, 192, 48, 192, 212, 212, 212, 212, 384, 212, 212, 212

3840

BIOS_SCR_SIZE_X: db 239, 255, 255, 63, 255, 255, 255, 255, 255, 255, 255, 255, 255

3841

BIOS_SCR_SIZE_Y: db 191, 191, 191, 47, 191, 211, 211, 211, 211, 255, 211, 211, 211

3842

3843

3844

;---------------------------------------------------------------------------------------------------------

3845

; gfxIsScreenModeMSX2

3846

; return if screen mode is from MSX 2

3847

; out C is set, if MSX2 and screen mode above 3

3848

;---------------------------------------------------------------------------------------------------------

3849

3850

gfxIsScreenModeMSX2:

3851

ld a, (BIOS_VERSION)

3852

or 0

3853

jp nz, BIOS_CHKNEW ; if not MSX1, jump to CHKNEW

3854

scf

3855

ret

3856

3857

;---------------------------------------------------------------------------------------------------------

3858

; gfxSetScreenMode

3859

; set current screen mode

3860

; in A = screen number

3861

;---------------------------------------------------------------------------------------------------------

3862

3863

gfxSetScreenMode:

3864

push af

3865

call gfxInitScreenWorkspace

3866

xor a

3867

ld a, (BIOS_VERSION)

3868

or 0

3869

jr nz, gfxSetScreenMode.1 ; if not MSX1, jump

3870

pop af

3871

cp 4

3872

call nc, gfxSetScreenMode.0 ; if screen mode >= 4, change to screen 2

3873

__call_bios BIOS_CHGMOD ; change the screen mode (msx1)

3874

jr gfxSetScreenMode.2

3875

3876

gfxSetScreenMode.0:

3877

ld a, 2

3878

ret

3879

3880

gfxSetScreenMode.1:

3881

pop af

3882

ld ix, BIOS_CHGMOD2 ; change the screen mode (msx2)

3883

call BIOS_EXTROM

3884

3885

gfxSetScreenMode.2:

3886

call gfxGetScreenHeight

3887

call gfxGetScreenWidth

3888

call gfxGetSpriteSize

3889

jp gfxFillSpriteCollisionTable

3890

3891

gfxInitScreenWorkspace:

3892

ld a, 1

3893

ld (GFX_SPRITE_FLAGS), a ; bits 0=chk limits, 1=chk walls, 2=chk hotspots, 3=limit touched, 4=wall touched, 5=hotspot touched, 6=collided

3894

xor a

3895

ld (GFX_SPRITE_WALLS), a

3896

ld (GFX_SPRITE_WALLS+1), a

3897

ld (GFX_SPRITE_HOTSPOTS), a

3898

ld (GFX_SPRITE_HOTSPOTS+1), a

3899

ld (GFX_MUSIC_START), a

3900

ld (GFX_MUSIC_START+1), a

3901

ld (GFX_MUSIC_NEXT), a

3902

ld (GFX_MUSIC_NEXT+1), a

3903

ld (GFX_MUSIC_PREV), a

3904

ld (GFX_MUSIC_PREV+1), a

3905

ld (GFX_SPRITE_HOTSPOT_TILE), a

3906

ld (GFX_SPRITE_COLLIDER), a

3907

ret

3908

3909

;---------------------------------------------------------------------------------------------------------

3910

; gfxGetScreenMode

3911

; return current screen mode

3912

; out A = screen number (0=40x24 Text Mode, 1=32x24 Text Mode, 2=Graphics Mode, 3=Multicolour Mode)

3913

;---------------------------------------------------------------------------------------------------------

3914

3915

gfxGetScreenMode:

3916

ld a, (BIOS_SCRMOD)

3917

ret

3918

3919

;---------------------------------------------------------------------------------------------------------

3920

; gfxSetXY

3921

; set current screen location

3922

; in BC = x

3923

; DE = y

3924

;---------------------------------------------------------------------------------------------------------

3925

3926

gfxSetXY:

3927

ld (BIOS_GRPACX), bc ; x

3928

;ld (BIOS_GXPOS), bc

3929

ld (BIOS_GRPACY), de ; y

3930

;ld (BIOS_GYPOS), de

3931

jr gfxRefreshXY.1

3932

3933

;---------------------------------------------------------------------------------------------------------

3934

; gfxRefreshXY

3935

; refresh current screen location

3936

;---------------------------------------------------------------------------------------------------------

3937

3938

gfxRefreshXY:

3939

ld bc, (BIOS_GRPACX) ; x

3940

ld de, (BIOS_GRPACY) ; y

3941

gfxRefreshXY.1:

3942

call gfxIsScreenModeMSX2

3943

jr nc, gfxRefreshXY.2 ; if MSX2 and screen mode above 3

3944

__call_bios BIOS_SCALXY ; BC = X, DE = Y

3945

__call_bios BIOS_MAPXYC ; in BC = X, DE = Y

3946

ret

3947

gfxRefreshXY.2:

3948

ld ix, BIOS_SCALXY2 ; BC = X, DE = Y

3949

call BIOS_EXTROM

3950

ld ix, BIOS_MAPXYC2 ; in BC = X, DE = Y

3951

jp BIOS_EXTROM

3952

3953

;---------------------------------------------------------------------------------------------------------

3954

; gfxGetXY

3955

; get current screen location

3956

; out BC = x

3957

; DE = y

3958

;---------------------------------------------------------------------------------------------------------

3959

3960

gfxGetXY:

3961

ld bc, (BIOS_GRPACX) ; x

3962

ld de, (BIOS_GRPACY) ; y

3963

ret

3964

3965

;---------------------------------------------------------------------------------------------------------

3966

; gfxGetScreenHeight

3967

; get screen height

3968

; out a = screen height

3969

;---------------------------------------------------------------------------------------------------------

3970

3971

gfxGetScreenHeight:

3972

push hl

3973

push de

3974

ld hl, BIOS_SCR_SIZE_Y

3975

ld a, (BIOS_SCRMOD)

3976

ld d, 0

3977

ld e, a

3978

add hl, de

3979

ld a, (hl)

3980

ld (GFX_MAX_Y), a

3981

pop de

3982

pop hl

3983

ret

3984

3985

;---------------------------------------------------------------------------------------------------------

3986

; gfxGetScreenWidth

3987

; get screen width

3988

; out a = screen height

3989

;---------------------------------------------------------------------------------------------------------

3990

3991

gfxGetScreenWidth:

3992

push hl

3993

push de

3994

ld hl, BIOS_SCR_SIZE_X

3995

ld a, (BIOS_SCRMOD)

3996

ld d, 0

3997

ld e, a

3998

add hl, de

3999

ld a, (hl)

4000

ld (GFX_MAX_X), a

4001

pop de

4002

pop hl

4003

ret

4004

4005

;---------------------------------------------------------------------------------------------------------

4006

; gfxGetSpriteSize

4007

; get sprite data size

4008

; out a = sprite data size

4009

;---------------------------------------------------------------------------------------------------------

4010

4011

gfxGetSpriteSize:

4012

push bc

4013

ld bc, 0x0808

4014

ld a, (BIOS_RG1SAV) ; bit 0 = double size, bit 1 = sprite size (0=8 pixels, 1=16 pixels)

4015

bit 1, a

4016

jr z, gfxGetSpriteSize.1

4017

ld bc, 0x1010

4018

4019

gfxGetSpriteSize.1:

4020

bit 0, a

4021

jr z, gfxGetSpriteSize.2

4022

sll b

4023

4024

gfxGetSpriteSize.2:

4025

ld (GFX_SPRITE_SIZE_DAT), bc

4026

ld a, c

4027

pop bc

4028

ret

4029

4030

4031

if defined GFX_FAST and defined PAINT

4032

4033

;---------------------------------------------------------------------------------------------------------

4034

; gfxUp

4035

; move screen current location up

4036

; out: carry if off screen

4037

;---------------------------------------------------------------------------------------------------------

4038

4039

gfxUp:

4040

push bc

4041

ld hl, 0

4042

ld de, (BIOS_GRPACY)

4043

or a

4044

sbc hl, de

4045

jr z, gfxUp.1

4046

dec de

4047

ld (BIOS_GRPACY), de

4048

call gfxRefreshXY

4049

scf

4050

ccf

4051

jr gfxUp.2

4052

gfxUp.1:

4053

scf

4054

gfxUp.2:

4055

pop bc

4056

ret

4057

4058

;---------------------------------------------------------------------------------------------------------

4059

; gfxDown

4060

; move screen current location down

4061

; out: carry if off screen

4062

;---------------------------------------------------------------------------------------------------------

4063

4064

gfxDown:

4065

push bc

4066

ld a, (GFX_MAX_Y)

4067

ld l, a

4068

ld h, 0

4069

ld de, (BIOS_GRPACY)

4070

or a

4071

sbc hl, de

4072

jr z, gfxDown.1

4073

inc de

4074

ld (BIOS_GRPACY), de

4075

call gfxRefreshXY

4076

scf

4077

ccf

4078

jr gfxDown.2

4079

gfxDown.1:

4080

scf

4081

gfxDown.2:

4082

pop bc

4083

ret

4084

4085

;---------------------------------------------------------------------------------------------------------

4086

; gfxLeft

4087

; move screen current location left

4088

; out: carry if off screen

4089

;---------------------------------------------------------------------------------------------------------

4090

4091

gfxLeft:

4092

push bc

4093

ld hl, 0

4094

ld de, (BIOS_GRPACX)

4095

or a

4096

sbc hl, de

4097

jr z, gfxLeft.1

4098

dec de

4099

ld (BIOS_GRPACX), de

4100

call gfxRefreshXY

4101

scf

4102

ccf

4103

jr gfxLeft.2

4104

gfxLeft.1:

4105

scf

4106

gfxLeft.2:

4107

pop bc

4108

ret

4109

4110

;---------------------------------------------------------------------------------------------------------

4111

; gfxRight

4112

; move screen current location right

4113

; out: carry if off screen

4114

;---------------------------------------------------------------------------------------------------------

4115

4116

gfxRight:

4117

push bc

4118

ld a, (GFX_MAX_X)

4119

ld l, a

4120

ld h, 0

4121

ld de, (BIOS_GRPACX)

4122

or a

4123

sbc hl, de

4124

jr z, gfxRight.1

4125

inc de

4126

ld (BIOS_GRPACX), de

4127

call gfxRefreshXY

4128

scf

4129

ccf

4130

jr gfxRight.2

4131

gfxRight.1:

4132

scf

4133

gfxRight.2:

4134

pop bc

4135

ret

4136

4137

endif

4138

4139

;---------------------------------------------------------------------------------------------------------

4140

; gfxPushXY

4141

; push current screen location

4142

;---------------------------------------------------------------------------------------------------------

4143

4144

gfxPushXY:

4145

4146

pop ix

4147

ld iy, (BIOS_GRPACX) ; x

4148

push iy

4149

ld iy, (BIOS_GRPACY) ; y

4150

push iy

4151

push ix

4152

4153

ret

4154

4155

;---------------------------------------------------------------------------------------------------------

4156

; gfxPopXY

4157

; pop current screen location

4158

; out BC = x

4159

; DE = y

4160

;---------------------------------------------------------------------------------------------------------

4161

4162

gfxPopXY:

4163

pop ix

4164

pop de ; y

4165

pop bc ; x

4166

push ix

4167

jp gfxSetXY

4168

4169

;---------------------------------------------------------------------------------------------------------

4170

; gfxSetForeColor

4171

; set current foreground color

4172

; A = color

4173

;---------------------------------------------------------------------------------------------------------

4174

4175

gfxSetForeColor:

4176

ld (BIOS_FORCLR), a ; foreground color

4177

ld (BIOS_ATRBYT), a

4178

ret

4179

4180

;---------------------------------------------------------------------------------------------------------

4181

; gfxGetForeColor

4182

; get current foreground color

4183

; out A = color

4184

;---------------------------------------------------------------------------------------------------------

4185

4186

gfxGetForeColor:

4187

ld a, (BIOS_FORCLR) ; foreground color

4188

ret

4189

4190

;---------------------------------------------------------------------------------------------------------

4191

; gfxSetBackColor

4192

; set current background color

4193

; A = color

4194

;---------------------------------------------------------------------------------------------------------

4195

4196

gfxSetBackColor:

4197

ld (BIOS_BAKCLR), a ; foreground color

4198

ret

4199

4200

;---------------------------------------------------------------------------------------------------------

4201

; gfxGetBackColor

4202

; get current background color

4203

; out A = color

4204

;---------------------------------------------------------------------------------------------------------

4205

4206

gfxGetBackColor:

4207

ld a, (BIOS_BAKCLR) ; foreground color

4208

ret

4209

4210

;---------------------------------------------------------------------------------------------------------

4211

; gfxSetBorderColor

4212

; set current border color

4213

; A = color

4214

;---------------------------------------------------------------------------------------------------------

4215

4216

gfxSetBorderColor:

4217

ld (BIOS_BDRCLR), a ; border color

4218

ret

4219

4220

;---------------------------------------------------------------------------------------------------------

4221

; gfxGetBorderColor

4222

; get current border color

4223

; out A = color

4224

;---------------------------------------------------------------------------------------------------------

4225

4226

gfxGetBorderColor:

4227

ld a, (BIOS_BDRCLR) ; border color

4228

ret

4229

4230

;---------------------------------------------------------------------------------------------------------

4231

; gfxSetBorderFill

4232

; set fill border color

4233

; A = color

4234

;---------------------------------------------------------------------------------------------------------

4235

4236

gfxSetBorderFill:

4237

ld (BIOS_BDRATR), a ; border color

4238

ret

4239

4240

;---------------------------------------------------------------------------------------------------------

4241

; gfxGetBorderFill

4242

; get fill border color

4243

; out A = color

4244

;---------------------------------------------------------------------------------------------------------

4245

4246

gfxGetBorderFill:

4247

ld a, (BIOS_BDRATR) ; border color

4248

ret

4249

4250

;---------------------------------------------------------------------------------------------------------

4251

; gfxSetColor

4252

; set current color (foreground, background and border)

4253

;---------------------------------------------------------------------------------------------------------

4254

4255

gfxSetColor:

4256

ld a, (BIOS_SCRMOD)

4257

bit 3, a

4258

jp nz, BIOS_CHGCLR2 ; change VDP colors - msx2

4259

bit 2, a

4260

jp nz, BIOS_CHGCLR2 ; change VDP colors - msx2

4261

jp BIOS_CHGCLR ; change VDP colors

4262

; __call_bios BIOS_SETATR ; change the pixel color

4263

;ret

4264

4265

;---------------------------------------------------------------------------------------------------------

4266

; gfxSetPixel

4267

; set pixel in current position to current foreground color

4268

;---------------------------------------------------------------------------------------------------------

4269

4270

gfxSetPixel:

4271

call gfxIsScreenModeMSX2

4272

jr nc, gfxSetPixel.1 ; if MSX2 and screen mode above 3

4273

__call_bios BIOS_SETC

4274

ret

4275

gfxSetPixel.1:

4276

ld ix, BIOS_SETC2

4277

jp BIOS_EXTROM

4278

4279

;---------------------------------------------------------------------------------------------------------

4280

; gfxGetPixel

4281

; get pixel color in current position

4282

; out A = pixel color

4283

;---------------------------------------------------------------------------------------------------------

4284

4285

gfxGetPixel:

4286

call gfxIsScreenModeMSX2

4287

jr nc, gfxGetPixel.1 ; if MSX2 and screen mode above 3

4288

__call_bios BIOS_READC

4289

ret

4290

gfxGetPixel.1:

4291

ld ix, BIOS_READC2

4292

jp BIOS_EXTROM

4293

4294

if defined LINE

4295

4296

;---------------------------------------------------------------------------------------------------------

4297

; gfxDrawLine

4298

; plot a line from current position to informed destination

4299

; in BC = destination x

4300

; DE = destination y

4301

; https://en.wikipedia.org/wiki/Bresenham%27s_line_algorithm#Algorithm_for_integer_arithmetic

4302

; https://rosettacode.org/wiki/Bitmap/Bresenham%27s_line_algorithm#C

4303

;---------------------------------------------------------------------------------------------------------

4304

;void line(int x0, int y0, int x1, int y1) {

4305

; int dx = abs(x1-x0), sx = x0<x1 ? 1 : -1;

4306

; int dy = abs(y1-y0), sy = y0<y1 ? 1 : -1;

4307

; int err = (dx>dy ? dx : -dy)/2, e2;

4308

; for(;;){

4309

; setPixel(x0,y0);

4310

; if (x0==x1 && y0==y1) break;

4311

; e2 = err;

4312

; if (e2 >-dx) { err -= dy; x0 += sx; }

4313

; if (e2 < dy) { err += dx; y0 += sy; }

4314

; }

4315

;}

4316

4317

gfxDrawLine:

4318

if not defined GFX_FAST

4319

ld hl, (BIOS_GRPACX)

4320

ld (BIOS_GXPOS), hl

4321

ld hl, (BIOS_GRPACY)

4322

ld (BIOS_GYPOS), hl

4323

__call_basic BASIC_SUB_LINE

4324

ret

4325

4326

else

4327

4328

ld (GFX_TEMP2), bc ; x

4329

ld (GFX_TEMP3), de ; y

4330

4331

ld hl, (BIOS_GRPACX) ; x0

4332

ld de, (GFX_TEMP2) ; x

4333

;or a

4334

;sbc hl, de

4335

;jp po, gfxLine.1 ; x0 >= x? else jump to endif

4336

call MATH.COMP.S16

4337

jp c, gfxLine.1 ; x0 < x? jump

4338

or a

4339

sbc hl, de

4340

ld (GFX_TEMP4), hl ; dx = x0 - x

4341

ld hl, 0xffff

4342

ld (GFX_TEMP5), hl ; sx = -1

4343

jr gfxLine.2

4344

4345

gfxLine.1:

4346

ld de, (BIOS_GRPACX) ; x0

4347

ld hl, (GFX_TEMP2) ; x

4348

or a

4349

sbc hl, de

4350

ld (GFX_TEMP4), hl ; dx = x - x0

4351

ld hl, 1

4352

ld (GFX_TEMP5), hl ; sx = 1

4353

4354

gfxLine.2:

4355

ld hl, (BIOS_GRPACY) ; y0

4356

ld de, (GFX_TEMP3) ; y

4357

;or a

4358

;sbc hl, de

4359

;jp po, gfxLine.3 ; y0 >= y? else, jump to endif

4360

call MATH.COMP.S16

4361

jp c, gfxLine.3 ; y0 < y? jump

4362

or a

4363

sbc hl, de

4364

ld (GFX_TEMP6), hl ; dy = y0 - y

4365

ld hl, 0xffff

4366

ld (GFX_TEMP7), hl ; sy = -1

4367

jr gfxLine.4

4368

4369

gfxLine.3:

4370

ld de, (BIOS_GRPACY) ; y0

4371

ld hl, (GFX_TEMP3) ; y

4372

or a

4373

sbc hl, de

4374

ld (GFX_TEMP6), hl ; dy = y - y0

4375

ld hl, 1

4376

ld (GFX_TEMP7), hl ; sy = 1

4377

4378

gfxLine.4:

4379

ld hl, (GFX_TEMP6) ; dy

4380

ld de, 0

4381

call MATH.COMP.S16

4382

jp z, gfxLine.h ; dy = 0?

4383

4384

ld hl, (GFX_TEMP4) ; dx

4385

ld de, 0

4386

call MATH.COMP.S16

4387

jp z, gfxLine.v ; dx = 0?

4388

4389

ld de, (GFX_TEMP4) ; dx

4390

ld hl, (GFX_TEMP6) ; dy

4391

or a

4392

adc hl, de

4393

dec hl

4394

dec hl

4395

ld (GFX_TEMP9), hl ; dxy = dx + dy

4396

4397

ld de, (GFX_TEMP4) ; dx

4398

ld hl, (GFX_TEMP6) ; dy

4399

;or a

4400

;sbc hl, de

4401

;jp pe, gfxLine.5 ; dy < dx? else, jump to endif

4402

call MATH.COMP.S16

4403

jp z, gfxLine.5 ; dy = dx? jump

4404

jp nc, gfxLine.5 ; dy > dx? jump

4405

;ld hl, 0

4406

ld de, (GFX_TEMP6) ; dy

4407

or a

4408

srl d

4409

rr e ; dy / 2

4410

;or a

4411

;sbc hl, de ; -dy

4412

ld (GFX_TEMP8), de ; err = -dy / 2

4413

jr gfxLine.loop

4414

4415

gfxLine.5:

4416

ld hl, (GFX_TEMP4) ; dx

4417

or a

4418

srl h

4419

rr l

4420

ld (GFX_TEMP8), hl ; err = dx/2

4421

4422

gfxLine.loop:

4423

call gfxSetPixel

4424

4425

ld hl, (GFX_TEMP9) ; dxy

4426

ld de, 0

4427

call MATH.COMP.S16

4428

jp nc, gfxLine.loop.0 ; dxy > 0? jump

4429

;jp z, gfxLine.loop.0 ; dxy = 0? jump

4430

4431

ret

4432

4433

gfxLine.loop.0:

4434

ld hl, 0

4435

ld de, (GFX_TEMP4) ; dx

4436

or a

4437

sbc hl, de ; -dx

4438

ld de, (GFX_TEMP8) ; e2 = err

4439

push de

4440

;or a

4441

;sbc hl, de

4442

;jp pe, gfxLine.loop.1 ; if -dx < e2, else jump to endif

4443

call MATH.COMP.S16

4444

jp z, gfxLine.loop.1 ; -dx = e2? jump

4445

jp nc, gfxLine.loop.1 ; -dx > e2? jump

4446

ld hl, (GFX_TEMP8) ; err

4447

ld de, (GFX_TEMP6) ; dy

4448

or a

4449

sbc hl, de

4450

ld (GFX_TEMP8), hl ; err -= dy

4451

4452

ld hl, (GFX_TEMP9) ; dxy

4453

dec hl

4454

ld (GFX_TEMP9), hl ; dxy -= 1

4455

4456

ld hl, (BIOS_GRPACX)

4457

ld de, (GFX_TEMP5)

4458

or a

4459

adc hl, de

4460

ld (BIOS_GRPACX), hl ; x0 += sx

4461

4462

gfxLine.loop.1:

4463

pop hl ; e2

4464

ld de, (GFX_TEMP6) ; dy

4465

;or a

4466

;sbc hl, de

4467

;jp pe, gfxLine.loop.2 ; if e2 < dy, else jump to endif

4468

call MATH.COMP.S16

4469

jp z, gfxLine.loop.2 ; e2 = dy? jump

4470

jp nc, gfxLine.loop.2 ; e2 > dy? jump

4471

ld hl, (GFX_TEMP8) ; err

4472

ld de, (GFX_TEMP4) ; dx

4473

or a

4474

adc hl, de

4475

ld (GFX_TEMP8), hl ; err += dx

4476

4477

ld hl, (GFX_TEMP9) ; dxy

4478

dec hl

4479

ld (GFX_TEMP9), hl ; dxy -= 1

4480

4481

ld hl, (BIOS_GRPACY)

4482

ld de, (GFX_TEMP7)

4483

or a

4484

adc hl, de

4485

ld (BIOS_GRPACY), hl ; y0 += sy

4486

4487

gfxLine.loop.2:

4488

call gfxRefreshXY

4489

jp gfxLine.loop

4490

4491

gfxLine.h:

4492

ld a, (GFX_TEMP5) ; sx

4493

bit 7, a

4494

jr z, gfxLine.h.1 ; if a is positive

4495

ld hl, (BIOS_GRPACX)

4496

ld de, (GFX_TEMP4)

4497

or a

4498

sbc hl, de

4499

ld (BIOS_GRPACX), hl

4500

call gfxRefreshXY

4501

4502

gfxLine.h.1:

4503

__call_bios BIOS_FETCHC

4504

ld hl, (GFX_TEMP4) ; dx

4505

inc hl

4506

call gfxDrawHorLine ; HL = pixel count

4507

ret

4508

4509

gfxLine.v:

4510

ld a, (GFX_TEMP7) ; sy

4511

bit 7, a

4512

jr z, gfxLine.v.1 ; if a is positive

4513

ld hl, (BIOS_GRPACY)

4514

ld de, (GFX_TEMP6)

4515

or a

4516

sbc hl, de

4517

ld (BIOS_GRPACY), hl

4518

call gfxRefreshXY

4519

4520

gfxLine.v.1:

4521

call gfxSetPixel

4522

ld hl, (GFX_TEMP6) ; dy

4523

inc hl

4524

ld (GFX_TEMP3), hl

4525

jp gfxBox.drawVerLine

4526

endif

4527

4528

endif

4529

4530

if defined BOX or defined FBOX or defined BOX_STEP or defined FBOX_STEP

4531

4532

;---------------------------------------------------------------------------------------------------------

4533

; gfxDrawBox

4534

; plot a box from current position to informed destination

4535

; in BC = destination x

4536

; DE = destination y

4537

; A = filled flag (0 = not filled, <>0 = filled)

4538

;---------------------------------------------------------------------------------------------------------

4539

4540

gfxDrawBox:

4541

4542

if not defined GFX_FAST

4543

ld hl, (BIOS_GRPACX)

4544

ld (BIOS_GXPOS), hl

4545

ld hl, (BIOS_GRPACY)

4546

ld (BIOS_GYPOS), hl

4547

ld hl, BASIC_SUB_LINEBOX

4548

or 0

4549

jr z, gfxDrawBox.1

4550

call gfxIsScreenModeMSX2

4551

jr nc, gfxDrawBox.2

4552

ld hl, BASIC_SUB_LINEBOXFILLED

4553

4554

gfxDrawBox.1:

4555

push hl

4556

pop ix

4557

jp BIOS_CALBAS ; BIOS_CALSLT

4558

4559

4560

gfxDrawBox.2:

4561

xor a

4562

ld hl, BASIC_BUF

4563

ld (hl), a

4564

ld ix, BIOS_DOBOXF

4565

jp BIOS_EXTROM

4566

4567

else

4568

call gfxAdjustDestXY

4569

or 0

4570

jr nz, gfxBox.filled

4571

4572

gfxBox.notFilled:

4573

call gfxPushXY

4574

call gfxBox.drawHorLine

4575

ld hl, (GFX_TEMP2)

4576

ld de, (BIOS_GRPACX)

4577

or a

4578

adc hl, de

4579

dec hl

4580

ld (BIOS_GRPACX), hl

4581

call gfxRefreshXY

4582

call gfxBox.drawVerLine

4583

call gfxPopXY

4584

call gfxBox.drawVerLine

4585

call gfxBox.drawHorLine

4586

ret

4587

4588

gfxBox.filled:

4589

ld hl, (GFX_TEMP3)

4590

;inc hl

4591

gfxBox.filled.loop:

4592

push hl

4593

ld bc, (BIOS_GRPACX)

4594

push bc

4595

call gfxBox.drawHorLine

4596

pop bc

4597

ld (BIOS_GRPACX), bc

4598

ld bc, (BIOS_GRPACY)

4599

inc bc

4600

ld (BIOS_GRPACY), bc

4601

call gfxRefreshXY

4602

pop hl

4603

ld de, 1

4604

or a

4605

sbc hl, de

4606

jr nz, gfxBox.filled.loop

4607

ret

4608

4609

gfxBox.drawHorLine:

4610

ld hl, (GFX_TEMP2)

4611

;inc hl

4612

call gfxDrawHorLine

4613

ret

4614

4615

gfxBox.drawVerLine:

4616

ld hl, (GFX_TEMP3)

4617

dec hl

4618

gfxBox.drawVerLine.loop:

4619

push hl

4620

call gfxDown

4621

call gfxSetPixel

4622

pop hl

4623

ld de, 1

4624

or a

4625

sbc hl, de

4626

jr nz, gfxBox.drawVerLine.loop

4627

ret

4628

4629

;---------------------------------------------------------------------------------------------------------

4630

; gfxDrawHorLine

4631

; draw a horizontal line

4632

; HL = pixel count

4633

;---------------------------------------------------------------------------------------------------------

4634

4635

gfxDrawHorLine:

4636

ld a, (BIOS_SCRMOD)

4637

cp 5

4638

jr c, gfxDrawHorLine.2 ; if screen mode < 5 then jump

4639

bit 7, h

4640

ret nz ; return if negative

4641

xor a

4642

cp h

4643

jr nz, gfxDrawHorLine.1

4644

cp l

4645

ret z ; return if hl = 0

4646

call gfxPushXY

4647

gfxDrawHorLine.1:

4648

push hl

4649

call gfxSetPixel

4650

call gfxRight

4651

pop hl

4652

ld de, 1

4653

sbc hl, de

4654

jr nz, gfxDrawHorLine.1

4655

call gfxPopXY

4656

ret

4657

gfxDrawHorLine.2:

4658

__call_bios BIOS_NSETCX ; HL = fill count

4659

ret

4660

4661

;---------------------------------------------------------------------------------------------------------

4662

; gfxAdjustDestXY

4663

; invert if dest XY is less than current XY position

4664

; BC = dest x

4665

; DE = dest y

4666

;---------------------------------------------------------------------------------------------------------

4667

4668

gfxAdjustDestXY:

4669

push af

4670

ld (GFX_TEMP2), bc ; x

4671

ld (GFX_TEMP3), de ; y

4672

4673

; verify x againt current position

4674

ld hl, (BIOS_GRPACX)

4675

ld de, (GFX_TEMP2)

4676

and a

4677

sbc hl, de ; dx = x1 - x0

4678

bit 7, h ; result is negative?

4679

jr z, gfxAdjustDestXY.1

4680

add hl, de

4681

ld (BIOS_GRPACX), hl

4682

ex de, hl

4683

or a

4684

sbc hl, de

4685

gfxAdjustDestXY.1:

4686

inc hl

4687

ld (GFX_TEMP2), hl

4688

4689

; verify y againt current position

4690

ld hl, (BIOS_GRPACY)

4691

ld de, (GFX_TEMP3)

4692

and a

4693

sbc hl, de ; dy = y1 - y0

4694

bit 7, h ; result is negative?

4695

jr z, gfxAdjustDestXY.2

4696

add hl, de

4697

ld (BIOS_GRPACY), hl

4698

ex de, hl

4699

or a

4700

sbc hl, de

4701

gfxAdjustDestXY.2:

4702

inc hl

4703

ld (GFX_TEMP3), hl

4704

4705

; refresh new position

4706

call gfxRefreshXY

4707

pop af

4708

ret

4709

endif

4710

4711

endif

4712

4713

if defined CIRCLE

4714

4715

;---------------------------------------------------------------------------------------------------------

4716

; gfxDrawCircle

4717

; plot a circle centered in current position

4718

; BC = tracing end x

4719

; DE = tracing end y

4720

; HL = radius

4721

; A = filled flag (0 = not filled, <>0 = filled)

4722

; https://en.wikipedia.org/wiki/Midpoint_circle_algorithm

4723

; https://rosettacode.org/wiki/Bitmap/Midpoint_circle_algorithm#C

4724

;---------------------------------------------------------------------------------------------------------

4725

4726

gfxDrawCircle:

4727

4728

if not defined GFX_FAST

4729

bit 7,h

4730

ret nz ; return if negative radius

4731

ld (BIOS_GXPOS), hl ; circle ray

4732

ld de, (BIOS_GXPOS)

4733

ld bc, (BIOS_GRPACY)

4734

ld (BIOS_GYPOS), bc

4735

xor a

4736

;cp h

4737

;jr nz, gfxDrawCircle.1

4738

;cp l

4739

;ret z

4740

gfxDrawCircle.1:

4741

ld hl, BASIC_BUF

4742

ld (hl), a

4743

ld ix, 0xFFFF

4744

__call_basic BASIC_SUB_CIRCLE

4745

ret

4746

else

4747

ld (GFX_TEMP), hl ; radius

4748

ld de, 0

4749

sbc hl, de

4750

ret z ; return if zero radius

4751

bit 7,h

4752

ret nz ; return if negative radius

4753

4754

call gfxGetXY

4755

ld (GFX_TEMP1), bc ; x0

4756

ld (GFX_TEMP2), de ; y0

4757

4758

or 0

4759

jp nz, gfxCircle.filled

4760

4761

gfxCircle.notFilled:

4762

ld hl, 1

4763

ld de, (GFX_TEMP) ; radius

4764

or a

4765

sbc hl, de

4766

ld (GFX_TEMP3), hl ; f = 1 - radius

4767

4768

ld hl, 0

4769

ld (GFX_TEMP4), hl ; ddF_x = 0

4770

4771

ld hl, (GFX_TEMP)

4772

or a

4773

adc hl, hl

4774

ex de, hl

4775

ld hl, 0

4776

or a

4777

sbc hl, de

4778

ld (GFX_TEMP5), hl ; ddF_y = -2 * radius

4779

4780

ld hl, 0

4781

ld (GFX_TEMP6), hl ; x = 0

4782

4783

ld hl, (GFX_TEMP)

4784

ld (GFX_TEMP7), hl ; y = radius

4785

4786

; plot(x0, y0 + radius)

4787

ld de, (GFX_TEMP) ; radius

4788

ld hl, (GFX_TEMP2) ; y0

4789

or a

4790

adc hl, de

4791

ex de, hl

4792

ld bc, (GFX_TEMP1) ; x0

4793

call gfxSetXY

4794

call gfxSetPixel

4795

4796

; plot(x0, y0 - radius)

4797

ld de, (GFX_TEMP) ; radius

4798

ld hl, (GFX_TEMP2) ; y0

4799

or a

4800

sbc hl, de

4801

ex de, hl

4802

ld bc, (GFX_TEMP1) ; x0

4803

call gfxSetXY

4804

call gfxSetPixel

4805

4806

; plot(x0 + radius, y0)

4807

ld hl, (GFX_TEMP1) ; x0

4808

ld de, (GFX_TEMP) ; radius

4809

or a

4810

adc hl, de

4811

;push hl

4812

;pop bc

4813

ld b, h

4814

ld c, l

4815

ld de, (GFX_TEMP2) ; y0

4816

call gfxSetXY

4817

call gfxSetPixel

4818

4819

; plot(x0 - radius, y0)

4820

ld hl, (GFX_TEMP1) ; x0

4821

ld de, (GFX_TEMP) ; radius

4822

or a

4823

sbc hl, de

4824

;push hl

4825

;pop bc

4826

ld b, h

4827

ld c, l

4828

ld de, (GFX_TEMP2) ; y0

4829

call gfxSetXY

4830

call gfxSetPixel

4831

jp gfxCircle.notFilled.3

4832

4833

gfxCircle.notFilled.1:

4834

ld hl, (GFX_TEMP3) ; f

4835

bit 7, h

4836

jr nz, gfxCircle.notFilled.2 ; if( f < 0 ), jump

4837

4838

ld hl, (GFX_TEMP7) ; y -= 1

4839

dec hl

4840

ld (GFX_TEMP7), hl

4841

4842

ld hl, (GFX_TEMP5) ; ddF_y += 2

4843

inc hl

4844

inc hl

4845

ld (GFX_TEMP5), hl

4846

4847

ld hl, (GFX_TEMP3) ; f

4848

ld de, (GFX_TEMP5) ; ddF_y

4849

or a

4850

adc hl, de

4851

ld (GFX_TEMP3), hl ; f += ddF_y

4852

4853

gfxCircle.notFilled.2:

4854

ld hl, (GFX_TEMP6) ; x

4855

inc hl

4856

ld (GFX_TEMP6), hl ; x++

4857

4858

ld hl, (GFX_TEMP4) ; ddF_x += 2

4859

inc hl

4860

inc hl

4861

ld (GFX_TEMP4), hl

4862

4863

ld hl, (GFX_TEMP3) ; f

4864

ld de, (GFX_TEMP4) ; ddF_x

4865

or a

4866

adc hl, de

4867

inc hl

4868

ld (GFX_TEMP3), hl ; f += ddF_x + 1

4869

4870

; plot(x0 + x, y0 + y)

4871

ld hl, (GFX_TEMP1) ; x0

4872

ld de, (GFX_TEMP6) ; x

4873

or a

4874

adc hl, de

4875

;push hl

4876

;pop bc

4877

ld b, h

4878

ld c, l

4879

ld hl, (GFX_TEMP2) ; y0

4880

ld de, (GFX_TEMP7) ; y

4881

or a

4882

adc hl, de

4883

ex de, hl

4884

call gfxSetXY

4885

call gfxSetPixel

4886

4887

; plot(x0 - x, y0 + y)

4888

ld hl, (GFX_TEMP1) ; x0

4889

ld de, (GFX_TEMP6) ; x

4890

or a

4891

sbc hl, de

4892

;push hl

4893

;pop bc

4894

ld b, h

4895

ld c, l

4896

ld hl, (GFX_TEMP2) ; y0

4897

ld de, (GFX_TEMP7) ; y

4898

or a

4899

adc hl, de

4900

ex de, hl

4901

call gfxSetXY

4902

call gfxSetPixel

4903

4904

; plot(x0 + x, y0 - y)

4905

ld hl, (GFX_TEMP1) ; x0

4906

ld de, (GFX_TEMP6) ; x

4907

or a

4908

adc hl, de

4909

;push hl

4910

;pop bc

4911

ld b, h

4912

ld c, l

4913

ld hl, (GFX_TEMP2) ; y0

4914

ld de, (GFX_TEMP7) ; y

4915

or a

4916

sbc hl, de

4917

ex de, hl

4918

call gfxSetXY

4919

call gfxSetPixel

4920

4921

; plot(x0 - x, y0 - y)

4922

ld hl, (GFX_TEMP1) ; x0

4923

ld de, (GFX_TEMP6) ; x

4924

or a

4925

sbc hl, de

4926

;push hl

4927

;pop bc

4928

ld b, h

4929

ld c, l

4930

ld hl, (GFX_TEMP2) ; y0

4931

ld de, (GFX_TEMP7) ; y

4932

or a

4933

sbc hl, de

4934

ex de, hl

4935

call gfxSetXY

4936

call gfxSetPixel

4937

4938

; plot(x0 + y, y0 + x)

4939

ld hl, (GFX_TEMP1) ; x0

4940

ld de, (GFX_TEMP7) ; y

4941

or a

4942

adc hl, de

4943

;push hl

4944

;pop bc

4945

ld b, h

4946

ld c, l

4947

ld hl, (GFX_TEMP2) ; y0

4948

ld de, (GFX_TEMP6) ; x

4949

or a

4950

adc hl, de

4951

ex de, hl

4952

call gfxSetXY

4953

call gfxSetPixel

4954

4955

; plot(x0 - y, y0 + x)

4956

ld hl, (GFX_TEMP1) ; x0

4957

ld de, (GFX_TEMP7) ; y

4958

or a

4959

sbc hl, de

4960

;push hl

4961

;pop bc

4962

ld b, h

4963

ld c, l

4964

ld hl, (GFX_TEMP2) ; y0

4965

ld de, (GFX_TEMP6) ; x

4966

or a

4967

adc hl, de

4968

ex de, hl

4969

call gfxSetXY

4970

call gfxSetPixel

4971

4972

; plot(x0 + y, y0 - x)

4973

ld hl, (GFX_TEMP1) ; x0

4974

ld de, (GFX_TEMP7) ; y

4975

or a

4976

adc hl, de

4977

;push hl

4978

;pop bc

4979

ld b, h

4980

ld c, l

4981

ld hl, (GFX_TEMP2) ; y0

4982

ld de, (GFX_TEMP6) ; x

4983

or a

4984

sbc hl, de

4985

ex de, hl

4986

call gfxSetXY

4987

call gfxSetPixel

4988

4989

; plot(x0 - y, y0 - x)

4990

ld hl, (GFX_TEMP1) ; x0

4991

ld de, (GFX_TEMP7) ; y

4992

or a

4993

sbc hl, de

4994

;push hl

4995

;pop bc

4996

ld b, h

4997

ld c, l

4998

ld hl, (GFX_TEMP2) ; y0

4999

ld de, (GFX_TEMP6) ; x

5000

or a

5001

sbc hl, de

5002

ex de, hl

5003

call gfxSetXY

5004

call gfxSetPixel

5005

5006

gfxCircle.notFilled.3:

5007

ld hl, (GFX_TEMP6) ; x

5008

ld de, (GFX_TEMP7) ; y

5009

or a

5010

sbc hl, de

5011

jp c, gfxCircle.notFilled.1 ; while( x < y )

5012

ld bc, (GFX_TEMP1) ; x0

5013

ld de, (GFX_TEMP2) ; y0

5014

call gfxSetXY

5015

ret

5016

5017

gfxCircle.filled

5018

call gfxCircle.notFilled

5019

ld hl, (BIOS_BDRATR)

5020

push hl

5021

ld hl, (BIOS_FORCLR)

5022

ld (BIOS_BDRATR), hl

5023

ld a, 1

5024

call gfxBorderFill

5025

pop hl

5026

ld (BIOS_BDRATR), hl

5027

ret

5028

endif

5029

5030

endif

5031

5032

if defined PAINT or (defined CIRCLE and defined GFX_FAST)

5033

5034

;---------------------------------------------------------------------------------------------------------

5035

; gfxBorderFill

5036

; Fill current region delimited by border attribute color changing pixels to foreground color

5037

; in: a = fill type (0 = not symmetric, 1 = symmetric)

5038

;---------------------------------------------------------------------------------------------------------

5039

5040

gfxBorderFill:

5041

5042

if not defined GFX_FAST

5043

5044

ld bc, (BIOS_GRPACX)

5045

ld (BIOS_GXPOS), bc

5046

ld de, (BIOS_GRPACY)

5047

ld (BIOS_GYPOS), de

5048

push bc

5049

push de

5050

5051

xor a

5052

ld hl, BASIC_BUF

5053

ld (hl), a

5054

5055

ld a, (BIOS_BDRATR)

5056

xor b

5057

ld e, a

5058

ld a, (BIOS_ATRBYT)

5059

xor d

5060

ld c, a

5061

;ld ix, 0xFFFF

5062

;ld iy, 0xFFFF

5063

5064

call gfxIsScreenModeMSX2

5065

jr nc, gfxBorderFill.1 ; if MSX2 and screen mode above 3, jump

5066

ld a, (BIOS_BDRATR)

5067

ld (BIOS_ATRBYT), a

5068

ld e, a

5069

__call_basic BASIC_SUB_PAINT1

5070

ret

5071

5072

gfxBorderFill.1:

5073

__call_basic BASIC_SUB_PAINT1

5074

ret

5075

;ld ix, BASIC_SUB_PAINT2

5076

;jp BIOS_EXTROM

5077

5078

else

5079

5080

ld (GFX_TEMP1), a

5081

ld hl, (BIOS_GRPACY)

5082

push hl

5083

call gfxBorderFill.down

5084

pop hl

5085

push hl

5086

ld (BIOS_GRPACY), hl

5087

call gfxRefreshXY

5088

call gfxBorderFill.up

5089

pop hl

5090

ld (BIOS_GRPACY), hl

5091

call gfxRefreshXY

5092

ret

5093

5094

gfxBorderFill.down:

5095

call gfxBorderFill.line

5096

call gfxDown

5097

ret c

5098

call gfxGetPixel

5099

ld hl, BIOS_BDRATR

5100

cp (hl)

5101

jr nz, gfxBorderFill.down

5102

ret

5103

5104

gfxBorderFill.up:

5105

call gfxBorderFill.line

5106

call gfxUp

5107

ret c

5108

call gfxGetPixel

5109

ld hl, BIOS_BDRATR

5110

cp (hl)

5111

jr nz, gfxBorderFill.up

5112

ret

5113

5114

gfxBorderFill.line:

5115

ld de, (BIOS_GRPACX)

5116

push de

5117

ld b, 1 ; fill flag

5118

ld de, 1 ; skip count

5119

__call_bios BIOS_SCANR

5120

;inc hl

5121

;ld (GFX_TEMP2), hl ; pixel count transversed

5122

pop de

5123

push de

5124

ld (BIOS_GRPACX), de

5125

call gfxRefreshXY

5126

;ld a, (GFX_TEMP1)

5127

;cp 0 ; 0 = not symmetric, 1 = symmetric

5128

;jr z, gfxBorderFill.line.1

5129

;ld hl, (GFX_TEMP2)

5130

;__call_bios BIOS_NSETCX ; HL = fill count

5131

;jr gfxBorderFill.line.2

5132

gfxBorderFill.line.1:

5133

ld b, 1 ; fill flag

5134

ld de, 0 ; skip count

5135

__call_bios BIOS_SCANL

5136

gfxBorderFill.line.2:

5137

pop de

5138

ld (BIOS_GRPACX), de

5139

call gfxRefreshXY

5140

ret

5141

5142

;---------------------------------------------------------------------------------------------------------

5143

; gfxFloadFill

5144

; Fload fill current region changing current pixel color to foreground color

5145

; https://en.wikipedia.org/wiki/Flood_fill

5146

;---------------------------------------------------------------------------------------------------------

5147

5148

gfxFloadFill:

5149

call gfxGetPixel

5150

ld (GFX_TEMP), a ; replacement-color

5151

call gfxFloadFill.recursive

5152

ret

5153

5154

gfxFloadFill.recursive:

5155

; 1. If target-color is equal to replacement-color, return.

5156

ld a, (GFX_TEMP)

5157

ld hl, BIOS_FORCLR

5158

cp (hl)

5159

ret z

5160

5161

; 2. ElseIf the color of node is not equal to target-color, return.

5162

call gfxGetPixel

5163

ld hl, GFX_TEMP

5164

cp (hl)

5165

ret nz

5166

5167

; 3. Else Set the color of node to replacement-color.

5168

call gfxSetPixel

5169

5170

; 4. Perform Flood-fill (one step to the left of node, target-color, replacement-color).

5171

gfxFloadFill.recursive.left:

5172

call gfxLeft

5173

jr c, gfxFloadFill.recursive.right

5174

call gfxFloadFill.recursive

5175

call gfxRight

5176

5177

; Perform Flood-fill (one step to the right of node, target-color, replacement-color).

5178

gfxFloadFill.recursive.right:

5179

call gfxRight

5180

jr c, gfxFloadFill.recursive.up

5181

call gfxFloadFill.recursive

5182

call gfxLeft

5183

5184

; Perform Flood-fill (one step to the up of node, target-color, replacement-color).

5185

gfxFloadFill.recursive.up:

5186

call gfxUp

5187

jr c, gfxFloadFill.recursive.down

5188

call gfxFloadFill.recursive

5189

call gfxDown

5190

5191

; Perform Flood-fill (one step to the down of node, target-color, replacement-color).

5192

gfxFloadFill.recursive.down:

5193

call gfxDown

5194

ret c

5195

call gfxFloadFill.recursive

5196

call gfxUp

5197

ret

5198

5199

endif

5200

5201

endif

5202

5203

if defined SPRITEMODE

5204

5205

;---------------------------------------------------------------------------------------------------------

5206

; gfxSetSpriteMode

5207

; set current sprite mode

5208

; A = sprite mode

5209

; 0: Spritesize is 8 by 8 pixels - default value

5210

; 1: Spritesize is 8 by 8 pixels, magnified to 16 by 16 pixels

5211

; 2: Spritesize is 16 by 16 pixels

5212

; 3: Spritesize is 16 by 16 pixels, magnified to 32 by 32 pixels

5213

; RG1SAV bit 0 = magnify sprite (double size)

5214

; RG1SAV bit 1 = sprite size (0=8 pixels, 1=16 pixels)

5215

;---------------------------------------------------------------------------------------------------------

5216

5217

gfxSetSpriteMode:

5218

and 3 ; keeps only bits 0 and 1 from A

5219

ld b, a

5220

5221

ld a, (BIOS_RG1SAV) ; get copy from register #1 of VDP

5222

and 0xFC ; clear bits 0 and 1 from A

5223

or b ; put parameter to A (bits 0 and 1)

5224

ld (BIOS_RG1SAV), a ; restore to register #1 of VDP

5225

ld b, a ; value to write

5226

ld c, 1 ; register number to write

5227

call gfxWRTVDP ; write register to VDP

5228

call gfxCLRSPR ; clear sprites

5229

5230

call gfxGetSpriteSize

5231

jp gfxFillSpriteCollisionTable

5232

5233

endif

5234

5235

if defined SPRITE or defined COLOR_SPRITE or defined PUT_SPRITE_COLOR or defined PUT_SPRITE_STEP_COLOR or defined PUT_SPRITE_COLOR_PATNUM or defined PUT_SPRITE_STEP_COLOR_PATNUM or defined LOAD_SET

5236

5237

;---------------------------------------------------------------------------------------------------------

5238

; gfxSetSpriteColorInt

5239

; A = sprite number

5240

; BC = color number

5241

;---------------------------------------------------------------------------------------------------------

5242

5243

gfxSetSpriteColorInt:

5244

ld b, a ; save sprite number

5245

call gfxCALATR ; get sprite attribute table address

5246

inc hl

5247

inc hl

5248

inc hl

5249

ld a, c ; color

5250

;call gfxSetSpriteColor.Adjust

5251

call gfxWRTVRM

5252

5253

ld a, (BIOS_SCRMOD)

5254

cp 3

5255

ret c ; if screen mode < 3, do not adjust sprite multicolor

5256

5257

ld a, b ; recover sprite number

5258

call gfxGetSpriteColorTable

5259

5260

ld a, c ; color

5261

;call gfxSetSpriteColor.Adjust

5262

ld b, 16 ; array of 16 bytes

5263

5264

gfxSetSpriteColorInt.1:

5265

push bc

5266

call gfxWRTVRM

5267

pop bc

5268

inc hl

5269

djnz gfxSetSpriteColorInt.1

5270

ret

5271

5272

;gfxSetSpriteColor.Adjust:

5273

; cp 0x0f

5274

; ret z

5275

; ret c

5276

; srl a

5277

; srl a

5278

; srl a

5279

; srl a

5280

; ret

5281

5282

;---------------------------------------------------------------------------------------------------------

5283

; gfxSetSpriteColorStr

5284

; A = sprite number

5285

; DE = address to color byte array

5286

; BC = color byte array size

5287

;---------------------------------------------------------------------------------------------------------

5288

5289

gfxSetSpriteColorStr:

5290

ld b, a ; save sprite number

5291

push bc

5292

push de

5293

call gfxCALATR ; get sprite attribute table

5294

pop de

5295

pop bc

5296

5297

ld a, c ; byte array zero length?

5298

or a

5299

ret z

5300

5301

inc hl

5302

inc hl

5303

inc hl

5304

ld a, (de) ; color

5305

;call gfxSetSpriteColor.Adjust

5306

call gfxWRTVRM

5307

5308

ld a, (BIOS_SCRMOD)

5309

cp 3

5310

ret c ; if screen mode < 3, do not adjust sprite mode 2

5311

5312

ld a, b ; recover sprite number

5313

call gfxGetSpriteColorTable

5314

5315

ld b, 16 ; array of 16 bytes (color table)

5316

ld a, c ; size of color array

5317

push de

5318

pop iy ; save array start

5319

5320

gfxSetSpriteColorStr.1:

5321

push af

5322

ld a, (de)

5323

;call gfxSetSpriteColor.Adjust

5324

call gfxWRTVRM

5325

inc hl

5326

inc de

5327

pop af

5328

dec a

5329

jr nz, gfxSetSpriteColorStr.2

5330

ld a, c ; recover array size

5331

push iy

5332

pop de ; recover array start

5333

5334

gfxSetSpriteColorStr.2:

5335

djnz gfxSetSpriteColorStr.1

5336

ret

5337

5338

5339

5340

;---------------------------------------------------------------------------------------------------------

5341

; gfxGetSpriteColorTable

5342

; A = sprite number

5343

; HL = address to color table

5344

;---------------------------------------------------------------------------------------------------------

5345

5346

gfxGetSpriteColorTable:

5347

push af

5348

push de

5349

ld h, 0

5350

ld l, a ; recover sprite number

5351

add hl, hl

5352

add hl, hl

5353

add hl, hl

5354

add hl, hl ; multiply by 16 (shift left 4)

5355

push hl

5356

xor a

5357

call gfxCALATR ; get sprite attribute table address

5358

pop de

5359

add hl, de

5360

xor a

5361

ld de, 512

5362

sbc hl, de ; address of color table from sprite multicolor

5363

pop de

5364

pop af

5365

ret

5366

5367

endif

5368

5369

if defined PUT_SPRITE or defined PUT_SPRITE_STEP or defined PUT_SPRITE_COLOR or defined PUT_SPRITE_STEP_COLOR or defined PUT_SPRITE_COLOR_PATNUM or defined PUT_SPRITE_STEP_COLOR_PATNUM or defined PUT_SPRITE_PATNUM or defined PUT_SPRITE_STEP_PATNUM

5370

5371

;---------------------------------------------------------------------------------------------------------

5372

; gfxSetSpriteXY

5373

; A = sprite number

5374

; BC = XY

5375

;---------------------------------------------------------------------------------------------------------

5376

5377

gfxSetSpriteXY:

5378

push bc

5379

call gfxCALATR ; get sprite attribute table address

5380

pop bc

5381

ld a, c ; y

5382

call gfxWRTVRM

5383

inc hl

5384

ld a, b ; x

5385

call gfxWRTVRM

5386

ret

5387

5388

;---------------------------------------------------------------------------------------------------------

5389

; gfxSpriteStepCheck

5390

; BC = XY

5391

;---------------------------------------------------------------------------------------------------------

5392

5393

gfxSpriteStepCheck:

5394

push hl

5395

push de

5396

push bc

5397

5398

ld de, (GFX_SPRITE_SIZE_DAT)

5399

ld a, (GFX_SPRITE_FLAGS) ; bits 0=chk limits, 1=chk walls, 2=chk hotspots, 3=limit touched, 4=wall touched, 5=hotspot touched, 6=collided

5400

and 7 ; clear touched and collided flags

5401

ld (GFX_SPRITE_FLAGS), a

5402

5403

bit 0, a

5404

jr z, gfxSpriteStepCheck.corners

5405

5406

gfxSpriteStepCheck.limits:

5407

ld a, (GFX_MAX_X)

5408

sub e ; sprite size

5409

cp b ; jump if x > max_x?

5410

jr c, gfxSpriteStepCheck.limits.touched

5411

5412

ld a, (GFX_MAX_Y)

5413

sub e ; sprite size

5414

cp c ; jump if y > max_y?

5415

jr c, gfxSpriteStepCheck.limits.touched

5416

5417

jr gfxSpriteStepCheck.corners

5418

5419

gfxSpriteStepCheck.limits.touched:

5420

ld a, (GFX_SPRITE_FLAGS) ; bits 0=chk limits, 1=chk walls, 2=chk hotspots, 3=limit touched, 4=wall touched, 5=hotspot touched, 6=collided

5421

or 8 ; set limit touched flag

5422

ld (GFX_SPRITE_FLAGS), a

5423

5424

gfxSpriteStepCheck.corners:

5425

ld a, (GFX_SPRITE_FLAGS) ; bits 0=chk limits, 1=chk walls, 2=chk hotspots, 3=limit touched, 4=wall touched, 5=hotspot touched, 6=collided

5426

and 2+4 ; check walls or hotspots

5427

jr z, gfxSpriteStepCheck.end

5428

5429

ld (GFX_TEMP10), bc

5430

call gfxSpriteStepCheck.corner

5431

5432

ld a, (GFX_SPRITE_SIZE_DAT)

5433

add a, b

5434

ld b, a

5435

call gfxSpriteStepCheck.corner

5436

5437

ld a, (GFX_SPRITE_SIZE_DAT)

5438

add a, c

5439

ld c, a

5440

call gfxSpriteStepCheck.corner

5441

5442

ld bc, (GFX_TEMP10)

5443

ld a, (GFX_SPRITE_SIZE_DAT)

5444

add a, c

5445

ld c, a

5446

call gfxSpriteStepCheck.corner

5447

5448

gfxSpriteStepCheck.end:

5449

pop bc

5450

pop de

5451

pop hl

5452

ret

5453

5454

gfxSpriteStepCheck.corner:

5455

call gfxGetTileFromXY

5456

ld d, a ; tile to be searched

5457

5458

ld a, (GFX_SPRITE_FLAGS) ; bits 0=chk limits, 1=chk walls, 2=chk hotspots, 3=limit touched, 4=wall touched, 5=hotspot touched, 6=collided

5459

bit 1, a

5460

call nz, gfxSpriteStepCheck.walls

5461

5462

ld a, (GFX_SPRITE_FLAGS) ; bits 0=chk limits, 1=chk walls, 2=chk hotspots, 3=limit touched, 4=wall touched, 5=hotspot touched, 6=collided

5463

bit 2, a

5464

call nz, gfxSpriteStepCheck.hotspots

5465

ret

5466

5467

gfxSpriteStepCheck.walls:

5468

ld hl, (GFX_SPRITE_WALLS)

5469

ld e, 16 ; bits 0=chk limits, 1=chk walls, 2=chk hotspots, 3=limit touched, 4=wall touched, 5=hotspot touched, 6=collided

5470

jp gfxSpriteStepCheck.search

5471

5472

gfxSpriteStepCheck.hotspots:

5473

ld hl, (GFX_SPRITE_HOTSPOTS)

5474

ld e, 32 ; bits 0=chk limits, 1=chk walls, 2=chk hotspots, 3=limit touched, 4=wall touched, 5=hotspot touched, 6=collided

5475

call gfxSpriteStepCheck.search

5476

5477

ld a, (GFX_SPRITE_FLAGS) ; bits 0=chk limits, 1=chk walls, 2=chk hotspots, 3=limit touched, 4=wall touched, 5=hotspot touched, 6=collided

5478

bit 5, a

5479

ret z

5480

5481

ld a, (GFX_TEMP1)

5482

ld (GFX_SPRITE_HOTSPOT_TILE), a

5483

ret

5484

5485

; d = tile, hl = search table, e = flag

5486

gfxSpriteStepCheck.search:

5487

ld a, h

5488

or l

5489

ret z

5490

5491

ld a, d ; search for this tile

5492

push bc

5493

ld c, (hl)

5494

inc hl

5495

ld b, (hl)

5496

inc hl

5497

cpir ; inc HL searching for A until BC=0 (Z flag settled if found)

5498

pop bc

5499

ret nz

5500

5501

gfxSpriteStepCheck.search.found:

5502

ld a, (GFX_SPRITE_FLAGS) ; bits 0=chk limits, 1=chk walls, 2=chk hotspots, 3=limit touched, 4=wall touched, 5=hotspot touched, 6=collided

5503

or e ; set touched flag

5504

ld (GFX_SPRITE_FLAGS), a

5505

ret

5506

5507

; b = x, c = y

5508

gfxGetTileFromXY:

5509

push bc

5510

ld a, c ; y

5511

srl b ; divide by 2

5512

srl b ; divide by 4

5513

srl b ; divide by 8

5514

ld c, b

5515

srl a

5516

srl a

5517

srl a

5518

ld b, a

5519

call gfxGetScreenTile ; b = y, c = x, a = tile

5520

pop bc

5521

ret

5522

5523

endif

5524

5525

if defined SPRITE or defined PUT_SPRITE or defined PUT_SPRITE_PATNUM or defined PUT_SPRITE_STEP_PATNUM or defined PUT_SPRITE_COLOR_PATNUM or defined PUT_SPRITE_STEP_COLOR_PATNUM

5526

5527

;---------------------------------------------------------------------------------------------------------

5528

; gfxSetSpritePattern

5529

; A = sprite number

5530

; BC = pattern number

5531

;---------------------------------------------------------------------------------------------------------

5532

5533

gfxSetSpritePattern:

5534

push bc

5535

call gfxCALATR ; get sprite attribute table address

5536

pop bc

5537

inc hl

5538

inc hl

5539

ld a, (BIOS_RG1SAV) ; bit 0 = double size, bit 1 = sprite size (0=8 pixels, 1=16 pixels)

5540

bit 1, a

5541

jr z, gfxSetSpritePattern.1

5542

sll c

5543

sll c

5544

gfxSetSpritePattern.1:

5545

ld a, c ; pattern number

5546

call gfxWRTVRM

5547

ret

5548

5549

endif

5550

5551

if defined SPRITE

5552

5553

;---------------------------------------------------------------------------------------------------------

5554

; gfxSetSpriteData

5555

; HL = point to sprite data as a string of 8 or 32 characters according the sprites size (8x8 or 16x16)

5556

; A = sprite number

5557

;---------------------------------------------------------------------------------------------------------

5558

5559

gfxSetSpriteData:

5560

push AF

5561

push HL

5562

call gfxCALPAT ; get sprite pattern data address

5563

ex DE, HL

5564

call gfxGSPSIZ ; return in 'a' sprite default size

5565

pop HL

5566

ld b, 0

5567

cp c

5568

jr z, gfxSetSpriteData.1

5569

jr nc, gfxSetSpriteData.1

5570

ld c, a

5571

gfxSetSpriteData.1:

5572

push bc

5573

ld c, a

5574

xor a

5575

call gfxFILVRM

5576

pop bc

5577

pop AF

5578

call gfxLDIRVM

5579

ret

5580

5581

endif

5582

5583

if defined GFX_SPRITES

5584

5585

;---------------------------------------------------------------------------------------------------------

5586

; gfxInitSprites

5587

; initialises all sprites

5588

;---------------------------------------------------------------------------------------------------------

5589

5590

gfxInitSprites:

5591

call gfxCLRSPR

5592

ret

5593

5594

;---------------------------------------------------------------------------------------------------------

5595

; gfxSetSpriteAttrs

5596

; set sprite default x, y, pattern and color

5597

; A = sprite number

5598

;---------------------------------------------------------------------------------------------------------

5599

5600

gfxSetSpriteAttrs:

5601

push af

5602

call gfxCALATR

5603

ld a, (BIOS_GRPACY) ; y

5604

call gfxWRTVRM

5605

inc hl

5606

ld a, (BIOS_GRPACX) ; x

5607

call gfxWRTVRM

5608

inc hl

5609

pop af ; pattern

5610

call gfxWRTVRM

5611

inc hl

5612

ld a, (BIOS_FORCLR) ; color

5613

call gfxWRTVRM

5614

ret

5615

5616

endif

5617

5618

if DATA_SET_ITEMS_COUNT > 0

5619

5620

;---------------------------------------------------------------------------------------------------------

5621

; gfxIsTileMode

5622

;---------------------------------------------------------------------------------------------------------

5623

5624

gfxIsTileMode:

5625

ld a, (BIOS_SCRMOD)

5626

cp 2

5627

ret z

5628

cp 4

5629

ret

5630

5631

;---------------------------------------------------------------------------------------------------------

5632

; gfxClearTileScreen

5633

;---------------------------------------------------------------------------------------------------------

5634

5635

gfxClearTileScreen:

5636

ld a, 0x20 ; space

5637

ld bc, 768

5638

ld hl, (BIOS_GRPNAM)

5639

call gfxFILVRM

5640

5641

ld de, 0x0020

5642

call gfxSetTileDefaultColor

5643

ld de, 0x0120

5644

call gfxSetTileDefaultColor

5645

ld de, 0x0220

5646

jp gfxSetTileDefaultColor

5647

5648

gfxSetTileDefaultColor

5649

call gfxGetTileColorAddr

5650

ex de, hl

5651

call gfxGetTileDefaultColor

5652

ld bc, 8

5653

jp gfxFILVRM

5654

5655

gfxGetTileDefaultColor:

5656

ld a, (BIOS_FORCLR)

5657

sla a

5658

sla a

5659

sla a

5660

sla a

5661

push hl

5662

ld hl, BIOS_BAKCLR

5663

or (hl)

5664

pop hl

5665

ret

5666

5667

; set tile color

5668

; HL = tile color pointer

5669

; BC = tile color size

5670

; DE = tile number

5671

5672

;---------------------------------------------------------------------------------------------------------

5673

; gfxSetTileData

5674

; set tile data

5675

; HL = tile data pointer

5676

; BC = tile data size

5677

; DE = tile number

5678

; A = flip (0=no, 1=yes)

5679

;---------------------------------------------------------------------------------------------------------

5680

5681

gfxSetTileData:

5682

or a

5683

jr nz, gfxSetTileDataFlip

5684

5685

gfxSetTileDataNoFlip:

5686

call gfxGetTileDataAddr

5687

jp gfxLDIRVM

5688

5689

gfxSetTileDataFlip:

5690

call gfxGetTileDataAddr

5691

ex de, hl

5692

gfxSetTileDataFlip.Loop:

5693

ld a, (de)

5694

call gfxReverseA

5695

call gfxWRTVRM

5696

inc de

5697

inc hl

5698

dec bc

5699

ld a, b

5700

cp c

5701

jr nz, gfxSetTileDataFlip.Loop

5702

ret

5703

5704

; in de = tile number

5705

; out de = tile number address

5706

gfxGetTileDataAddr:

5707

push hl

5708

ex de, hl

5709

add hl, hl

5710

add hl, hl

5711

add hl, hl ; tile number * 8

5712

ld de, (BIOS_GRPCGP)

5713

add hl, de

5714

ex de, hl

5715

pop hl

5716

ret

5717

5718

;---------------------------------------------------------------------------------------------------------

5719

; gfxSetTileColor

5720

; set tile color

5721

; HL = tile color pointer

5722

; BC = tile color size

5723

; DE = tile number

5724

;---------------------------------------------------------------------------------------------------------

5725

5726

gfxSetTileColor:

5727

call gfxGetTileColorAddr

5728

jp gfxLDIRVM

5729

5730

; in de = tile number

5731

; out de = tile number address

5732

gfxGetTileColorAddr:

5733

push hl

5734

ex de, hl

5735

add hl, hl

5736

add hl, hl

5737

add hl, hl ; tile number * 8

5738

ld de, (BIOS_GRPCOL)

5739

add hl, de

5740

ex de, hl

5741

pop hl

5742

ret

5743

5744

;---------------------------------------------------------------------------------------------------------

5745

; gfxSetScreenTile

5746

; set screen tile at x,y

5747

; C = x

5748

; B = y

5749

; a = tile number

5750

;---------------------------------------------------------------------------------------------------------

5751

5752

gfxSetScreenTile:

5753

ex af, af'

5754

ld a, 23

5755

cp b

5756

ret c

5757

ld a, 31

5758

cp c

5759

ret c

5760

;push bc

5761

; ld h, 0

5762

; ld l, b ; slow y * 32

5763

; ld bc, 32

5764

; call MATH.MULT.16

5765

;pop bc

5766

ld h, b

5767

sra h

5768

sra h

5769

sra h

5770

ld l, b

5771

sla l

5772

sla l

5773

sla l

5774

sla l

5775

sla l ; fast y * 32

5776

ld d, 0

5777

ld e, c ; x

5778

add hl, de

5779

ld de, (BIOS_GRPNAM)

5780

add hl, de

5781

ex af, af'

5782

jp gfxWRTVRM

5783

5784

endif

5785

5786

if defined gfxGetTileFromXY or DATA_SET_ITEMS_COUNT > 0

5787

5788

;---------------------------------------------------------------------------------------------------------

5789

; gfxGetScreenTile

5790

; get screen tile at x,y

5791

; C = x

5792

; B = y

5793

; a = tile number

5794

;---------------------------------------------------------------------------------------------------------

5795

5796

gfxGetScreenTile:

5797

ld a, 23

5798

cp b

5799

ret c

5800

ld a, 31

5801

cp c

5802

ret c

5803

ld h, b

5804

sra h

5805

sra h

5806

sra h

5807

ld l, b

5808

sla l

5809

sla l

5810

sla l

5811

sla l

5812

sla l ; fast y * 32

5813

ld d, 0

5814

ld e, c ; x

5815

add hl, de

5816

ld de, (BIOS_GRPNAM)

5817

add hl, de

5818

jp gfxRDVRM

5819

5820

endif

5821

5822

;---------------------------------------------------------------------------------------------------------

5823

; Sprite collision table routines

5824

;---------------------------------------------------------------------------------------------------------

5825

5826

gfxInitSpriteCollisionTable:

5827

ld bc, 128

5828

call memory.alloc

5829

ld (GFX_SPRITE_COLLISION), ix

5830

ret

5831

5832

; copy sprite attribute table to ram

5833

gfxFillSpriteCollisionTable:

5834

ld hl, (BIOS_ATRBAS) ; source: attribute table

5835

ld de, (GFX_SPRITE_COLLISION) ; dest: ram

5836

ld bc, 128 ; 32*4 = size of attribute table

5837

call gfxLDIRMV

5838

5839

; pre-calculate each sprite width

5840

gfxCalculateSpriteCollisionTable:

5841

ld ix, (GFX_SPRITE_COLLISION) ; start of sprites attributes

5842

ld b, 32 ; sprite count

5843

5844

gfxCalculateSpriteCollisionTable.start:

5845

ld a, (GFX_SPRITE_SIZE_DAT) ; sprite size

5846

ld c, a

5847

ld d, 208 ; Y no-display flag

5848

5849

; test screen mode

5850

ld a, (BIOS_SCRMOD)

5851

cp 3 ; above screen 3?

5852

jr c, gfxCalculateSpriteCollisionTable.next

5853

ld d, 216 ; Y no-display flag

5854

5855

gfxCalculateSpriteCollisionTable.next:

5856

; test IC flag (no collision) in color table

5857

; test EC flag (early clock, shift 32 dots to the left) in color table

5858

; set x1 = x + size, y1 = y + size

5859

ld a, (ix) ; y

5860

cp d ; test if sprite will not be displayed

5861

ret z

5862

5863

add a, c

5864

ld (ix+2), a ; y1

5865

ld a, (ix+1) ; x

5866

add a, c

5867

ld (ix+3), a ; x1

5868

5869

inc ix

5870

inc ix

5871

inc ix

5872

inc ix

5873

djnz gfxCalculateSpriteCollisionTable.next

5874

ret

5875

5876

; BC = sprite number to check

5877

gfxUpdateSpriteCollisionTable:

5878

ld (BIOS_TEMP), bc

5879

ld h, b

5880

ld l, c

5881

add hl, hl

5882

add hl, hl

5883

ld b, h

5884

ld c, l

5885

ld hl, (GFX_SPRITE_COLLISION) ; dest: ram

5886

add hl, bc

5887

ex de, hl

5888

ld hl, (BIOS_ATRBAS) ; source: attribute table

5889

add hl, bc

5890

ld bc, 4 ; 4 = size of attribute table to 1 sprite]

5891

push de

5892

call gfxLDIRMV

5893

pop ix

5894

ld b, 1 ; sprite count

5895

push ix

5896

call gfxCalculateSpriteCollisionTable.start

5897

pop iy

5898

5899

ld a, (GFX_SPRITE_FLAGS)

5900

and 0xBF ; clear collision flag

5901

ld (GFX_SPRITE_FLAGS), a

5902

5903

ld a, (BIOS_STATFL) ; verify if collision occurred

5904

bit 5, a

5905

ret z

5906

jr gfxCheckSpriteCollisionTable.start

5907

5908

; BC = sprite number to check

5909

gfxCheckSpriteCollisionTable:

5910

; get target sprite address (iy)

5911

ld (BIOS_TEMP), bc

5912

ld h, b

5913

ld l, c

5914

ld de, (GFX_SPRITE_COLLISION)

5915

add hl, hl ; x4

5916

add hl, hl

5917

add hl, de

5918

push hl

5919

pop iy

5920

5921

gfxCheckSpriteCollisionTable.start:

5922

; start test against others sprites

5923

ld ix, (GFX_SPRITE_COLLISION)

5924

ld bc, 0

5925

ld d, 208 ; Y no-display flag

5926

5927

; test screen mode

5928

ld a, (BIOS_SCRMOD)

5929

cp 3 ; above screen 3?

5930

jr c, gfxCheckSpriteCollisionTable.test

5931

ld d, 216 ; Y no-display flag

5932

5933

gfxCheckSpriteCollisionTable.test:

5934

; skip target sprite

5935

ld a, (BIOS_TEMP)

5936

cp c

5937

jr z, gfxCheckSpriteCollisionTable.next

5938

5939

; test if x1 > nx and x < nx1 and y1 > ny and y < ny1

5940

ld a, (ix) ; ny

5941

cp d ; test if sprite will not be displayed

5942

ret z ; return false

5943

5944

cp (iy+2) ; y1

5945

jr nc, gfxCheckSpriteCollisionTable.next

5946

5947

ld a, (ix+1) ; nx

5948

cp (iy+3) ; x1

5949

jr nc, gfxCheckSpriteCollisionTable.next

5950

5951

ld a, (iy+1) ; x

5952

cp (ix+3) ; nx1

5953

jr nc, gfxCheckSpriteCollisionTable.next

5954

5955

ld a, (iy) ; y

5956

cp (ix+2) ; ny1

5957

jr nc, gfxCheckSpriteCollisionTable.next

5958

5959

; if so, save collider sprite

5960

ld a, c

5961

ld (GFX_SPRITE_COLLIDER), a

5962

5963

ld a, (GFX_SPRITE_FLAGS)

5964

or 0x40 ; set collision flag

5965

ld (GFX_SPRITE_FLAGS), a

5966

ret ; return true

5967

5968

; else, next

5969

gfxCheckSpriteCollisionTable.next:

5970

inc c

5971

inc ix

5972

inc ix

5973

inc ix

5974

inc ix

5975

ld a, 32

5976

cp c

5977

ret z ; return false

5978

jr gfxCheckSpriteCollisionTable.test

5979

5980

5981

5982

;---------------------------------------------------------------------------------------------------------

5983

; VDP / VRAM support routines

5984

;---------------------------------------------------------------------------------------------------------

5985

5986

; WRITE TO VDP

5987

; in b = data

5988

; c = register number

5989

; a = register number

5990

gfxWRTVDP:

5991

bit 7, a

5992

ret nz ; is negative? read only

5993

cp 8

5994

ret z ; is register 8? then status register 0 (read only)

5995

jr nc, gfxWRTVDP.1 ; is > 8? then control registers numbers added 1

5996

jr gfxWRTVDP.3

5997

gfxWRTVDP.1:

5998

ld ix, BIOS_SCRMOD

5999

bit 3, (ix)

6000

jr nz, gfxWRTVDP.2

6001

bit 2, (ix)

6002

jr nz, gfxWRTVDP.2

6003

ret

6004

gfxWRTVDP.2:

6005

dec a

6006

ld c, a

6007

gfxWRTVDP.3:

6008

;ld ix, BIOS_SCRMOD

6009

;bit 3, (ix)

6010

;jp nz, BIOS_NWRVDP ; msx 2

6011

;bit 2, (ix)

6012

;jp nz, BIOS_NWRVDP ; msx 2

6013

jp BIOS_WRTVDP ; msx 1

6014

6015

; READ FROM VDP

6016

; in a = register number

6017

; out a = data

6018

gfxRDVDP:

6019

bit 7, a

6020

jr nz, gfxRDVDP.1 ; is negative? then status register 1 to 9

6021

cp 8

6022

jr z, gfxRDVDP.2 ; is register 8? then status register 0

6023

cp 9

6024

jr nc, gfxRDVDP.3 ; is >= 9? then control registers numbers added 1

6025

ld hl, BIOS_RG0SAV ; else is correct control registers numbers

6026

jr gfxRDVDP.4

6027

gfxRDVDP.1:

6028

ld ix, BIOS_SCRMOD

6029

bit 3, (ix)

6030

jr nz, gfxRDVDP.1.a

6031

bit 2, (ix)

6032

jr nz, gfxRDVDP.1.a

6033

xor a

6034

ret

6035

gfxRDVDP.1.a:

6036

neg

6037

jp BIOS_NRDVDP ;BIOS_VDPSTA

6038

gfxRDVDP.2:

6039

ld a, (BIOS_STATFL)

6040

ret

6041

;xor a

6042

;jp BIOS_VDPSTA

6043

gfxRDVDP.3:

6044

ld hl, BIOS_RG8SAV-9

6045

gfxRDVDP.4:

6046

ld d, 0

6047

ld e, a

6048

add hl,de

6049

ld a, (hl)

6050

ret

6051

6052

; in: A=Data byte, BC=Length, HL=VRAM address

6053

gfxFILVRM:

6054

ld ix, BIOS_SCRMOD

6055

bit 3, (ix)

6056

jp nz, BIOS_BIGFIL

6057

bit 2, (ix)

6058

jp nz, BIOS_BIGFIL

6059

jp BIOS_FILVRM

6060

6061

; in: A=Sprite pattern number

6062

; out: HL=Sprite pattern address

6063

gfxCALPAT:

6064

ld iy, BIOS_SCRMOD

6065

ld ix, BIOS_CALPAT2

6066

bit 3, (iy)

6067

jp nz, BIOS_EXTROM

6068

bit 2, (iy)

6069

jp nz, BIOS_EXTROM

6070

jp BIOS_CALPAT

6071

6072

; in: A=Sprite number

6073

; out: HL=Sprite attribute address

6074

gfxCALATR:

6075

ld iy, BIOS_SCRMOD

6076

ld ix, BIOS_CALATR2

6077

bit 3, (iy)

6078

jp nz, BIOS_EXTROM

6079

bit 2, (iy)

6080

jp nz, BIOS_EXTROM

6081

jp BIOS_CALATR

6082

6083

; out: A=Bytes in sprite pattern (8 or 32)

6084

gfxGSPSIZ:

6085

ld iy, BIOS_SCRMOD

6086

ld ix, BIOS_GSPSIZ2

6087

bit 3, (iy)

6088

jp nz, BIOS_EXTROM

6089

bit 2, (iy)

6090

jp nz, BIOS_EXTROM

6091

jp BIOS_GSPSIZ

6092

6093

gfxCLRSPR:

6094

ld iy, BIOS_SCRMOD

6095

ld ix, BIOS_CLRSPR2

6096

bit 3, (iy)

6097

jp nz, BIOS_EXTROM

6098

bit 2, (iy)

6099

jp nz, BIOS_EXTROM

6100

jp BIOS_CLRSPR

6101

6102

; RAM to VRAM

6103

; in: BC=Length, dest DE=VRAM address, source HL=RAM address

6104

gfxLDIRVM:

6105

jp BIOS_LDIRVM

6106

6107

; VRAM to RAM

6108

; in: BC=Length, dest DE=RAM address, source HL=VRAM address

6109

gfxLDIRMV:

6110

jp BIOS_LDIRMV

6111

6112

; WRITE TO VRAM

6113

; in hl = address

6114

; a = data

6115

gfxWRTVRM:

6116

ld ix, BIOS_SCRMOD

6117

bit 3, (ix)

6118

jp nz, BIOS_NWRVRM

6119

bit 2, (ix)

6120

jp nz, BIOS_NWRVRM

6121

jp BIOS_WRTVRM

6122

6123

; READ FROM VRAM

6124

; in hl = address

6125

; out a = data

6126

gfxRDVRM:

6127

ld ix, BIOS_SCRMOD

6128

bit 3, (ix)

6129

jp nz, BIOS_NRDVRM

6130

bit 2, (ix)

6131

jp nz, BIOS_NRDVRM

6132

jp BIOS_RDVRM

6133

6134

; reverse bits in A

6135

; 8 bytes / 206 cycles

6136

; http://www.retroprogramming.com/2014/01/fast-z80-bit-reversal.html

6137

gfxReverseA:

6138

ld b,8

6139

ld l,a

6140

gfxReverseA.loop:

6141

rl l

6142

rra

6143

djnz gfxReverseA.loop

6144

ret

6145

6146

6147

6148

6149

;---------------------------------------------------------------------------------------------------------

6150

; MATH PACK WRAPPER

6151

;---------------------------------------------------------------------------------------------------------

6152

6153

CALL_MATH_LIB: exx

6154

ld hl, RET_MATH_LIB

6155

push hl

6156

ld hl, BASIC_DAC

6157

ld de, BASIC_ARG

6158

ld bc, BASIC_SWPTMP

6159

jp (ix)

6160

RET_MATH_LIB: call COPY_TO.TMP_DAC

6161

exx

6162

ret

6163

6164

if defined MATH.ADD

6165

6166

MATH_DECADD: ld ix, addSingle

6167

jp CALL_MATH_LIB

6168

6169

endif

6170

6171

if defined MATH.SUB or defined MATH.NEG

6172

6173

MATH_DECSUB: ld ix, subSingle

6174

jp CALL_MATH_LIB

6175

6176

endif

6177

6178

if defined MATH.MULT

6179

6180

MATH_DECMUL: ld ix, mulSingle

6181

jp CALL_MATH_LIB

6182

6183

endif

6184

6185

if defined MATH.DIV

6186

6187

MATH_DECDIV: ld ix, divSingle

6188

jp CALL_MATH_LIB

6189

6190

endif

6191

6192

if defined MATH.POW

6193

6194

MATH_DBLEXP:

6195

MATH_SNGEXP: ld ix, powSingle

6196

jp CALL_MATH_LIB

6197

6198

endif

6199

6200

if defined COS

6201

6202

MATH_COS: ld ix, cosSingle

6203

jp CALL_MATH_LIB

6204

6205

endif

6206

6207

if defined SIN

6208

6209

MATH_SIN: ld ix, sinSingle

6210

jp CALL_MATH_LIB

6211

6212

endif

6213

6214

if defined TAN

6215

6216

MATH_TAN: ld ix, tanSingle

6217

jp CALL_MATH_LIB

6218

6219

endif

6220

6221

if defined ATN

6222

6223

MATH_ATN: ld ix, atanSingle

6224

jp CALL_MATH_LIB

6225

6226

endif

6227

6228

if defined SQR

6229

6230

MATH_SQR: ld ix, sqrtSingle

6231

jp CALL_MATH_LIB

6232

6233

endif

6234

6235

if defined LOG

6236

6237

MATH_LOG: ld ix, lnSingle

6238

jp CALL_MATH_LIB

6239

6240

endif

6241

6242

if defined EXP

6243

6244

MATH_EXP: ld ix, expSingle

6245

jp CALL_MATH_LIB

6246

6247

endif

6248

6249

if defined ABS

6250

6251

MATH_ABSFN: ld ix, absSingle

6252

jp CALL_MATH_LIB

6253

6254

endif

6255

6256

if defined MATH.SEED or defined MATH.NEG

6257

6258

MATH_NEG: ld ix, negSingle

6259

jp CALL_MATH_LIB

6260

6261

endif

6262

6263

if defined SGN

6264

6265

MATH_SGN: ld ix, sgnSingle

6266

jp CALL_MATH_LIB

6267

6268

endif

6269

6270

if defined RND or defined MATH.SEED

6271

6272

MATH_RND: ld ix, randSingle

6273

jp CALL_MATH_LIB

6274

6275

endif

6276

6277

MATH_FRCINT: ld hl, BASIC_DAC

6278

ld bc, BASIC_DAC+2

6279

call single2Int

6280

ld ix, BASIC_DAC

6281

ld (ix), 0

6282

ld (ix+1), 0

6283

;ld (ix+2), l

6284

;ld (ix+3), h

6285

ld (ix+4), 0

6286

ld (ix+5), 0

6287

ld (ix+6), 0

6288

ld (ix+7), 0

6289

ld a, 2

6290

ld (BASIC_VALTYP), a

6291

ret

6292

6293

MATH_FRCDBL: ; same as MATH_FRCSGL

6294

MATH_FRCSGL: ld hl, BASIC_DAC+2 ; input address

6295

ld bc, BASIC_DAC ; output address

6296

call int2Single

6297

ld a, 8

6298

ld (BASIC_VALTYP), a

6299

ret

6300

6301

MATH_ICOMP: ld a, h ; cp hl, de (alternative to bios DCOMPR)

6302

cp d

6303

jr nz, MATH_ICOMP.NE.HIGH

6304

ld a, l

6305

cp e

6306

jr nz, MATH_ICOMP.NE.LOW

6307

jr MATH_DCOMP.EQ

6308

MATH_ICOMP.NE.HIGH: jr c, MATH_ICOMP.GT.HIGH

6309

bit 7, a

6310

jr nz, MATH_DCOMP.GT

6311

jr MATH_DCOMP.LT

6312

MATH_ICOMP.GT.HIGH: bit 7, d

6313

jr z, MATH_DCOMP.GT

6314

jr MATH_DCOMP.LT

6315

MATH_ICOMP.NE.LOW: jr c, MATH_DCOMP.GT

6316

jr MATH_DCOMP.LT

6317

6318

MATH_XDCOMP: ; same as MATH_DCOMP

6319

MATH_DCOMP: ld ix, cmpSingle

6320

call CALL_MATH_LIB

6321

jr z, MATH_DCOMP.EQ

6322

jr c, MATH_DCOMP.LT

6323

MATH_DCOMP.GT: ld a, 0xFF ; DAC > ARG

6324

ret

6325

MATH_DCOMP.EQ: ld a, 0 ; DAC = ARG

6326

ret

6327

MATH_DCOMP.LT: ld a, 1 ; DAC < ARG

6328

ret

6329

6330

if defined CAST_STR_TO.VAL

6331

6332

MATH_FIN: ; HL has the source string

6333

ld a, (BASIC_VALTYP)

6334

cp 2 ; test if integer

6335

jr nz, MATH_FIN.1

6336

ld hl, (BASIC_DAC+2)

6337

ld de, BASIC_STRBUF

6338

call StrToInt

6339

ld hl, BASIC_STRBUF

6340

ret

6341

MATH_FIN.1: ld BC, BASIC_DAC

6342

call str2single

6343

ret

6344

6345

endif

6346

6347

if defined CAST_INT_TO.STR

6348

6349

MATH_FOUT: ld a, (BASIC_VALTYP)

6350

cp 2 ; test if integer

6351

jr nz, MATH_FOUT.1

6352

ld hl, (BASIC_DAC+2)

6353

ld de, BASIC_STRBUF

6354

call IntToStr

6355

ld hl, BASIC_STRBUF

6356

ret

6357

MATH_FOUT.1: ld hl, BASIC_DAC

6358

ld bc, BASIC_STRBUF

6359

call single2str

6360

ld hl, BASIC_STRBUF

6361

ret

6362

6363

endif

6364

6365

6366

6367

6368

;---------------------------------------------------------------------------------------------------------

6369

; Z80FLOAT LIBRARY

6370

6371

;---------------------------------------------------------------------------------------------------------

6372

; References:

6373

; https://github.com/Zeda/z80float

6374

; https://www.omnimaga.org/asm-language/(z80)-floating-point-routines/

6375

; https://en.wikipedia.org/wiki/Single-precision_floating-point_format

6376

;---------------------------------------------------------------------------------------------------------

6377

; Parameters:

6378

; HL points to the first operand

6379

; DE points to the second operand (if needed)

6380

; IX points to the third operand (if needed, rare)

6381

; BC points to where the result should be output

6382

; Floats are stored by a little-endian 24-bit mantissa. However, the highest bit

6383

; is taken as implicitly 1, so we replace it as a sign bit. Next comes an 8-bit

6384

; exponent biased by +128.

6385

;---------------------------------------------------------------------------------------------------------

6386

; Adapted to MSXBas2Asm by Amaury Carvalho, 2019

6387

;---------------------------------------------------------------------------------------------------------

6388

6389

;---------------------------------------------------------------------------------------------------------

6390

; Work area

6391

;---------------------------------------------------------------------------------------------------------

6392

6393

BASIC_HOLD8: equ 0xF806 ; 48 Work area for decimal multiplications.

6394

BASIC_HOLD2: equ 0xF836 ; 8 Work area in the execution of numerical operators.

6395

BASIC_HOLD: equ 0xF83E ; 8 Work area in the execution of numerical operators.

6396

scrap: equ BASIC_HOLD8

6397

seed0: equ BASIC_RNDX

6398

seed1: equ seed0 + 4

6399

var48: equ scrap + 4

6400

quot: equ scrap + 1

6401

addend: equ scrap

6402

addend2: equ scrap+7 ;4 bytes

6403

var_x: equ BASIC_HOLD8 + 4 ;4 bytes

6404

var_y: equ var_x + 4 ;4 bytes

6405

var_z: equ var_y + 4 ;4 bytes

6406

var_a: equ var_z + 4 ;4 bytes

6407

var_b: equ var_a + 4 ;4 bytes

6408

var_c: equ var_b + 4 ;4 bytes

6409

temp: equ var_c + 4 ;4 bytes

6410

temp1: equ temp + 4 ;4 bytes

6411

temp2: equ temp1 + 4 ;4 bytes

6412

temp3: equ temp2 + 4 ;4 bytes

6413

6414

pow10exp_single: equ scrap+9

6415

strout_single: equ 0xF750 ; PARM2 - BASIC_BUF ;pow10exp_single+2

6416

6417

;---------------------------------------------------------------------------------------------------------

6418

; addSingle

6419

;---------------------------------------------------------------------------------------------------------

6420

6421

;;Still need to tend to special cases

6422

addSingle:

6423

;;x+y

6424

push af

6425

push hl

6426

push de

6427

push bc

6428

addInject:

6429

inc de

6430

inc de

6431

inc hl

6432

inc hl

6433

ld a,(de)

6434

xor (hl)

6435

push af

6436

inc de

6437

inc hl

6438

ex de,hl

6439

ld a,(de)

6440

sub (hl)

6441

ex de,hl

6442

jr nc,$+5

6443

ex de,hl

6444

neg

6445

cp 24

6446

jp nc,add_unneeded

6447

push hl

6448

ld hl,addend+6

6449

dec de

6450

ld bc,0408h

6451

dec hl

6452

ld (hl),0

6453

sub c

6454

jr nc,$-5

6455

add a,c

6456

push af

6457

push hl

6458

ex de,hl

6459

ld a,(hl)

6460

or 80h

6461

ld (de),a

6462

dec de

6463

dec hl

6464

ldd

6465

ldd

6466

ex de,hl

6467

dec b

6468

jr z,$+7

6469

ld (hl),0

6470

dec hl

6471

djnz $-3

6472

pop hl

6473

pop af

6474

ld b,a

6475

jr z,noshift

6476

set 7,(hl)

6477

_1:

6478

push hl

6479

srl (hl)

6480

dec hl

6481

rr (hl)

6482

dec hl

6483

rr (hl)

6484

dec hl

6485

rr (hl)

6486

pop hl

6487

djnz _1

6488

noshift:

6489

pop hl ;bigger float

6490

dec hl

6491

ld b,(hl)

6492

dec hl

6493

dec hl

6494

ex de,hl

6495

pop af

6496

jp m,subtract

6497

ld hl,addend+2

6498

ld a,(hl)

6499

rla

6500

inc hl

6501

ld a,(de)

6502

adc a,(hl)

6503

ld (hl),a

6504

inc hl

6505

inc de

6506

ld a,(de)

6507

adc a,(hl)

6508

ld (hl),a

6509

inc hl

6510

inc de

6511

ld a,(de)

6512

set 7,a

6513

adc a,(hl)

6514

ld (hl),a

6515

inc hl

6516

inc de

6517

ld a,(de)

6518

ld (hl),a

6519

jp nc,add_done

6520

inc (hl)

6521

jp z,add_overflow

6522

dec hl

6523

rr (hl)

6524

dec hl

6525

rr (hl)

6526

dec hl

6527

rr (hl)

6528

jp add_done

6529

subtract:

6530

ld hl,addend

6531

xor a

6532

ld c,a

6533

sub (hl)

6534

ld (hl),a

6535

inc hl

6536

ld a,c

6537

sbc a,(hl)

6538

ld (hl),a

6539

inc hl

6540

ld a,c

6541

sbc a,(hl)

6542

ld (hl),a

6543

inc hl

6544

ld a,(de)

6545

sbc a,(hl)

6546

ld (hl),a

6547

inc hl

6548

inc de

6549

ld a,(de)

6550

sbc a,(hl)

6551

ld (hl),a

6552

inc hl

6553

inc de

6554

ld a,(de)

6555

set 7,a

6556

sbc a,(hl)

6557

ld (hl),a

6558

inc hl

6559

inc de

6560

ld a,(de)

6561

ld (hl),a

6562

dec de

6563

ex de,hl

6564

jr nc,negated

6565

ld hl,addend

6566

ld a,80h

6567

xor b

6568

ld b,a

6569

ld a,c

6570

sub (hl)

6571

ld (hl),a

6572

inc hl

6573

ld a,c

6574

sbc a,(hl)

6575

ld (hl),a

6576

inc hl

6577

ld a,c

6578

sbc a,(hl)

6579

ld (hl),a

6580

inc hl

6581

ld a,c

6582

sbc a,(hl)

6583

ld (hl),a

6584

inc hl

6585

ld a,c

6586

sbc a,(hl)

6587

ld (hl),a

6588

inc hl

6589

ld a,c

6590

sbc a,(hl)

6591

ld (hl),a

6592

negated:

6593

jp m,add_done

6594

push bc

6595

ld hl,(addend)

6596

ld de,(addend+2)

6597

ld bc,(addend+4)

6598

ld a,h

6599

or l

6600

or d

6601

or e

6602

or b

6603

or c

6604

jp z,add_underflow

6605

ld a,(addend+6)

6606

normalize:

6607

dec a

6608

jr z,add_underflow

6609

add hl,hl

6610

rl e

6611

rl d

6612

rl c

6613

rl b

6614

jp p,normalize

6615

ld (addend),hl

6616

ld (addend+2),de

6617

ld (addend+4),bc

6618

ld (addend+6),a

6619

pop bc

6620

add_done:

6621

;;Need to adjust sign flag

6622

ld hl,addend+5

6623

ld a,(hl)

6624

rla

6625

rl b

6626

rra

6627

ld (hl),a

6628

dec hl

6629

dec hl

6630

add_copy:

6631

pop de

6632

push de

6633

ldi

6634

ldi

6635

ldi

6636

ld a,(hl)

6637

ld (de),a

6638

pop bc

6639

pop de

6640

pop hl

6641

pop af

6642

ret

6643

add_underflow:

6644

;;How many push/pops are needed?

6645

;;return ZERO

6646

ld hl,0

6647

ld (addend+3),hl

6648

ld (addend+5),hl

6649

pop bc

6650

jr add_done

6651

add_overflow:

6652

;;How many push/pops are needed?

6653

;;return INF

6654

dec hl

6655

ld (hl),40h

6656

jr add_done

6657

add_unneeded:

6658

;;How many push/pops are needed?

6659

;;Return bigger number

6660

pop af

6661

dec hl

6662

dec hl

6663

dec hl

6664

jr add_copy

6665

6666

;---------------------------------------------------------------------------------------------------------

6667

; subSingle

6668

;---------------------------------------------------------------------------------------------------------

6669

6670

subSingle:

6671

;;x-y

6672

push af

6673

push hl

6674

push de

6675

push bc

6676

push hl

6677

ex de,hl

6678

ld de,addend2

6679

ldi

6680

ldi

6681

ld a,(hl)

6682

xor 80h

6683

ld (de),a

6684

inc de

6685

inc hl

6686

ld a,(hl)

6687

ld (de),a

6688

ex de,hl

6689

pop hl

6690

ld de,addend2

6691

jp addInject ;jumps in to the addSingle routine

6692

6693

;---------------------------------------------------------------------------------------------------------

6694

; mulSingle

6695

;---------------------------------------------------------------------------------------------------------

6696

6697

mulSingle:

6698

;Inputs: HL points to float1, DE points to float2, BC points to where the result is copied

6699

;Outputs: float1*float2 is stored to (BC)

6700

;573+mul24+{0,35}+{0,30}

6701

;min: 1398cc

6702

;max: 2564cc

6703

;avg: 2055.13839751681cc

6704

push af

6705

push hl

6706

push de

6707

push bc

6708

6709

call _2 ;CHLB

6710

ld a,c

6711

ex de,hl

6712

pop hl

6713

push hl

6714

ld (hl),b

6715

inc hl

6716

ld (hl),e

6717

inc hl

6718

ld (hl),d

6719

inc hl

6720

ld (hl),a

6721

pop bc

6722

pop de

6723

pop hl

6724

pop af

6725

ret

6726

6727

6728

_2:

6729

;;return float in CHLB

6730

push de

6731

ld e,(hl)

6732

inc hl

6733

ld d,(hl)

6734

inc hl

6735

ld c,(hl)

6736

inc hl

6737

ld a,(hl)

6738

or a

6739

jr z,mulSingle_case0

6740

ex de,hl

6741

ex (sp),hl

6742

ld e,(hl)

6743

inc hl

6744

ld d,(hl)

6745

inc hl

6746

ld b,(hl)

6747

inc hl

6748

6749

;inc (hl)

6750

;dec (hl)

6751

;jr z,mulSingle_case1

6752

push af

6753

ld a, (hl)

6754

or a

6755

jp z,mulSingle_case1

6756

pop af

6757

6758

add a,(hl) ;\

6759

pop hl ; |

6760

rra ; |Lots of help from Runer112 and

6761

adc a,a ; |calc84maniac for optimizing

6762

jp po,bad ; |this exponent check.

6763

xor 80h ; |

6764

jr z,underflow ;/

6765

push af ;exponent

6766

ld a,b

6767

xor c

6768

push af ;sign

6769

set 7,b

6770

set 7,c

6771

call mul24 ;BDE*CHL->HLBCDE, returns sign info

6772

pop de

6773

ld a,e

6774

pop de

6775

jp m,_3

6776

rl c

6777

rl b

6778

adc hl,hl

6779

dec d

6780

_3:

6781

inc d

6782

jr z,overflow

6783

rl c

6784

ld c,d

6785

ld de,0

6786

push af

6787

ld a,b

6788

adc a,e

6789

ld b,a

6790

adc hl,de

6791

jr nc,_4

6792

inc c

6793

jr z,overflow

6794

rr h

6795

rr l

6796

rr b

6797

_4:

6798

pop af

6799

cpl

6800

and $80

6801

xor h

6802

ld h,a

6803

ret

6804

bad:

6805

jr nc,overflow

6806

underflow:

6807

ld hl,0

6808

rl b

6809

rr h

6810

ld c,l

6811

ld b,l

6812

ret

6813

overflow:

6814

ld hl,$8000

6815

jr underflow+3

6816

mulSingle_case1:

6817

;x*0 -> 0

6818

;x*inf -> inf

6819

;x*NaN -> NaN

6820

pop af

6821

pop hl

6822

ld h,b

6823

ld l,d

6824

ld b,e

6825

ld c,0

6826

ret

6827

mulSingle_case0:

6828

;special*x = special

6829

;NaN*x = NaN

6830

;0*0 = 0

6831

;0*NaN = NaN

6832

;0*Inf = NaN

6833

;Inf*Inf = Inf

6834

;Inf*-Inf =-Inf

6835

;0CDE

6836

pop hl

6837

inc hl

6838

inc hl

6839

inc hl

6840

ld a,(hl)

6841

or a

6842

jr z,_5

6843

ld h,c

6844

ld c,0

6845

ret

6846

_5:

6847

dec hl

6848

ld b,(hl)

6849

;basically, if b|c has bit 5 set, return NaN

6850

ld a,b

6851

or c

6852

ld h,$20

6853

and h

6854

jr z,_6

6855

ld c,0

6856

ret

6857

_6:

6858

ld a,c

6859

xor b

6860

rl b

6861

rlca

6862

rr b

6863

res 4,b

6864

6865

rl c

6866

rrca

6867

rr c

6868

6869

ld a,c

6870

and $E0

6871

add a,b

6872

rra

6873

ld h,a

6874

ld c,0

6875

ret

6876

mul24:

6877

;;BDE*CHL -> HLBCDE

6878

;;155 bytes

6879

;;402+3*C_Times_BDE

6880

;;fastest:1201cc

6881

;;slowest:1753cc

6882

;;avg :1464.9033203125cc (1464+925/1024)

6883

;min: 825cc

6884

;max: 1926cc

6885

;avg: 1449.63839751681cc

6886

6887

push bc

6888

ld c,l

6889

push hl

6890

call C_Times_BDE

6891

ld (var48),hl

6892

ld l,a

6893

ld h,c

6894

ld (var48+2),hl

6895

6896

pop hl

6897

ld c,h

6898

call C_Times_BDE

6899

push bc

6900

ld bc,(var48+1)

6901

add hl,bc

6902

ld (var48+1),hl

6903

pop bc

6904

ld b,c

6905

ld c,a

6906

ld hl,(var48+3)

6907

ld h,0

6908

adc hl,bc

6909

ld (var48+3),hl

6910

6911

pop bc

6912

call C_Times_BDE

6913

ld de,(var48+2)

6914

add hl,de

6915

ld (var48+2),hl

6916

ld d,c

6917

ld e,a

6918

ld b,h

6919

ld c,l

6920

ld hl,(var48+4)

6921

ld h,0

6922

adc hl,de

6923

ld de,(var48)

6924

ret

6925

6926

;---------------------------------------------------------------------------------------------------------

6927

; divSingle

6928

;---------------------------------------------------------------------------------------------------------

6929

6930

divSingle:

6931

;;HL points to numerator

6932

;;DE points to denominator

6933

;;BC points to where the quotient gets written

6934

call pushpop

6935

divSingle_no_pushpop:

6936

inc hl

6937

inc de

6938

inc hl

6939

inc de

6940

ld a,(de) ;\

6941

xor (hl) ; |Get sign of output

6942

add a,a ; |

6943

push af ;/

6944

push bc

6945

inc hl

6946

inc de

6947

ld a,(hl) ;\

6948

ex de,hl ; |Get exponent

6949

sub (hl) ; |

6950

ex de,hl ; |

6951

6952

ld b,-1

6953

jr nc,_7

6954

dec b

6955

_7:

6956

add a,128

6957

jr nc,_8

6958

inc b

6959

_8:

6960

inc b

6961

jr z,_9

6962

jp p,divunderflow

6963

jp m,divoverflow

6964

_9:

6965

ld (quot+3),a

6966

dec hl

6967

dec de

6968

ld b,(hl)

6969

dec hl

6970

ld a,(hl)

6971

dec hl

6972

ld l,(hl)

6973

ld h,a

6974

ex de,hl

6975

6976

ld c,(hl)

6977

dec hl

6978

ld a,(hl)

6979

dec hl

6980

ld l,(hl)

6981

ld h,a

6982

ex de,hl

6983

6984

set 7,c

6985

ld a,b

6986

or 80h

6987

sbc hl,de

6988

sbc a,c

6989

jr nz,_10

6990

or h

6991

or l

6992

jr z,setmantissa0

6993

xor a

6994

_10:

6995

jr nc,startdiv

6996

ld b,a

6997

ld a,(quot+3)

6998

dec a

6999

ld (quot+3),a

7000

ld a,b

7001

add hl,hl

7002

adc a,a

7003

add hl,de

7004

adc a,c

7005

startdiv:

7006

ld b,1

7007

call divsub0+3

7008

ld (quot+1),bc

7009

call divsub0

7010

ld (quot),bc

7011

call divsub0

7012

ld (quot-1),bc

7013

add hl,hl

7014

rla

7015

jr c,_11

7016

sbc hl,de

7017

sbc a,c

7018

ccf

7019

_11:

7020

ld hl,(quot)

7021

ld de,(quot+2)

7022

ld bc,0

7023

adc hl,bc

7024

ex de,hl

7025

adc hl,bc

7026

ld b,h

7027

ld c,l

7028

writeback:

7029

pop hl

7030

ld (hl),e

7031

inc hl

7032

ld (hl),d

7033

inc hl

7034

rl c

7035

pop af

7036

rr c

7037

ld (hl),c

7038

inc hl

7039

ld (hl),b

7040

ret

7041

divoverflow:

7042

ld b,$40

7043

jr _12

7044

divunderflow:

7045

ld b,0

7046

jr _12

7047

setmantissa0:

7048

ld bc,(quot+2)

7049

_12:

7050

ld de,0

7051

ld c,e

7052

jr writeback

7053

divsub0:

7054

;;882cc max

7055

call divsub1 ;34 or 66

7056

call divsub1 ;

7057

call divsub1

7058

call divsub1

7059

call divsub1

7060

call divsub1

7061

call divsub1

7062

call divsub1

7063

or a

7064

sbc hl,de

7065

sbc a,c

7066

inc b

7067

ret nc

7068

dec b

7069

add hl,de

7070

adc a,c

7071

ret

7072

divsub1:

7073

;34cc or 66cc or 93cc

7074

sla b

7075

add hl,hl

7076

rla

7077

ret nc

7078

or a

7079

inc b

7080

sbc hl,de

7081

sbc a,c

7082

ret c

7083

inc b

7084

sbc hl,de

7085

sbc a,c

7086

ret

7087

7088

;---------------------------------------------------------------------------------------------------------

7089

; powSingle

7090

; https://www.geeksforgeeks.org/write-a-c-program-to-calculate-powxn/

7091

; https://stackoverflow.com/questions/3518973/floating-point-exponentiation-without-power-function

7092

;---------------------------------------------------------------------------------------------------------

7093

;double mypow( double base, double power, double precision )

7094

;{

7095

; if ( power < 0 ) return 1 / mypow( base, -power, precision );

7096

; else if ( power >= 1 ) return base * mypow( base, power-1, precision );

7097

; else if ( precision >= 1 ) {

7098

; if( base >= 0 ) return sqrt( base );

7099

; else return sqrt( -base );

7100

; } else return sqrt( mypow( base, power*2, precision*2 ) );

7101

;}

7102

7103

if defined MATH.POW or defined MATH_EXP or defined MATH_LOG or defined MATH_LN

7104

7105

powSingle:

7106

;;Computes y^x

7107

;;HL points to y

7108

;;DE points to x

7109

;;BC points to output

7110

call pushpop

7111

push bc

7112

push de

7113

ld bc, var_y ; power

7114

call copySingle

7115

pop hl

7116

ld bc, var_x ; base

7117

call copySingle

7118

ld hl, const_precision

7119

ld bc, var_a ; precision

7120

call copySingle

7121

ld hl, const_0

7122

ld bc, var_z ; result

7123

call copySingle

7124

call powSingle.loop

7125

pop bc

7126

ld hl, var_z

7127

call copySingle

7128

ret

7129

7130

powSingle.loop:

7131

; if ( power < 0 ) return 1 / mypow( base, -power, precision );

7132

ld hl, var_y

7133

ld de, const_0

7134

call cmpSingle

7135

jp c, powSingle.1

7136

7137

; else if ( power >= 1 ) return base * mypow( base, power-1, precision );

7138

ld hl, var_y

7139

ld de, const_1

7140

call cmpSingle

7141

jp nc, powSingle.2

7142

7143

; else if ( precision >= 1 ) {

7144

; if( base >= 0 ) return sqrt( base );

7145

; else return sqrt( -base );

7146

ld hl, var_a

7147

ld de, const_1

7148

call cmpSingle

7149

jp nc, powSingle.3

7150

7151

; } else return sqrt( mypow( base, power*2, precision*2 ) );

7152

ld hl, var_y

7153

ld de, const_2

7154

ld bc, var_b

7155

call mulSingle

7156

ld hl, var_b

7157

ld bc, var_y

7158

call copySingle

7159

ld hl, var_a

7160

ld de, const_2

7161

ld bc, var_b

7162

call mulSingle

7163

ld hl, var_b

7164

ld bc, var_a

7165

call copySingle

7166

call powSingle.loop

7167

ld hl, var_z

7168

ld bc, var_b

7169

call sqrtSingle

7170

ld hl, var_b

7171

ld bc, var_z

7172

call copySingle

7173

ret

7174

7175

powSingle.1:

7176

; return 1 / mypow( base, -power, precision );

7177

ld hl, const_0

7178

ld de, var_y

7179

ld bc, var_b

7180

call subSingle

7181

ld hl, var_b

7182

ld bc, var_y

7183

call copySingle

7184

call powSingle.loop

7185

ld hl, const_1

7186

ld de, var_z

7187

ld bc, var_b

7188

call divSingle

7189

ld hl, var_b

7190

ld bc, var_z

7191

call copySingle

7192

ret

7193

7194

powSingle.2:

7195

; return base * mypow( base, power-1, precision );

7196

ld hl, var_y

7197

ld de, const_1

7198

ld bc, var_b

7199

call subSingle

7200

ld hl, var_b

7201

ld bc, var_y

7202

call copySingle

7203

call powSingle.loop

7204

ld hl, var_z

7205

ld de, var_x

7206

ld bc, var_b

7207

call mulSingle

7208

ld hl, var_b

7209

ld bc, var_z

7210

call copySingle

7211

ret

7212

7213

powSingle.3:

7214

; if( base >= 0 ) return sqrt( base );

7215

; else return sqrt( -base );

7216

ld hl, var_x

7217

ld de, const_0

7218

call cmpSingle

7219

jp nc, powSingle.1

7220

;ld hl, var_x

7221

ld bc, var_b

7222

call negSingle

7223

ld hl, var_b

7224

;ld bc, var_z

7225

;call sqrtSingle

7226

;ret

7227

7228

powSingle.3.1:

7229

;ld hl, var_x

7230

ld bc, var_z

7231

call sqrtSingle

7232

ret

7233

7234

pow2Single:

7235

;;Computes 2^x

7236

call pushpop

7237

push bc

7238

7239

exp_inject:

7240

;if x is on [0,1):

7241

; 2^x = 1.000000001752 + x * (0.693146989552 + x * (0.2402298085906 + x * (5.54833215071e-2 + x * (9.67907584392e-3 + x * (1.243632065103e-3 + x * 2.171671843714e-4)))))

7242

;Please note that usually I like to reduce to [-.5,.5] as the extra overhead is usually worth it.

7243

;In this case, our polynomial is the same degree, with error different by less than 1 bit, so it's just a waste to range-reduce in this way.

7244

;

7245

;int(x) -> out_exp

7246

;x-=int(x) ;leaves x in [0,1)

7247

;;If x==0 -> out==1

7248

;;if x==inf -> out==inf

7249

;;if x==-inf -> out==0

7250

;;if x==NAN -> out==NAN

7251

ld de,var48+10

7252

call mov4

7253

ld hl,(var48+10)

7254

ld de,(var48+12)

7255

ld a,e

7256

add a,a

7257

push af ;keep track of sign

7258

rrca

7259

ld (var48+12),a

7260

ld c,a

7261

ld a,d

7262

or a

7263

jp z,exp_spec

7264

cp 80h-23

7265

jp c,exp_underflow

7266

sub 128 ; sub a,128

7267

jr c,_pow_1 ;int(x)=0

7268

inc a

7269

cp 7

7270

jp nc,exp_overflow

7271

set 7,c

7272

ld b,a

7273

xor a

7274

add hl,hl

7275

rl c

7276

rla

7277

djnz $-4

7278

ld b,7Fh

7279

bit 7,c

7280

jr nz,exp_normalized

7281

ld e,a

7282

ld a,h

7283

or l

7284

or c

7285

ld a,e

7286

jr z,exp_zeroed

7287

dec b

7288

add hl,hl

7289

rl c

7290

jp p,$-4

7291

jr exp_normalized ;.db $11 ;start of `ld de,**`

7292

exp_zeroed:

7293

ld b,0

7294

exp_normalized:

7295

ld (var48+10),hl

7296

res 7,c

7297

ld (var48+12),bc

7298

jr comp_exp ;.db $06 ;start of 'ld b,*` just to eat the next byte

7299

_pow_1:

7300

xor a

7301

comp_exp:

7302

pop hl

7303

rr l

7304

jr nc,_pow_2

7305

cpl

7306

or a

7307

jp z,exp_underflow+1

7308

;perform 1-(var48+10)--> var48+10

7309

ld hl,const_1

7310

ld de,var48+10

7311

ld b,d

7312

ld c,e

7313

call subSingle

7314

_pow_2:

7315

push af

7316

;our 'x' is at var48+10

7317

;our `temp` is at var48+6 so as not to cause issues with mulSingle)

7318

;uses 14 bytes of RAM

7319

ld hl,var48+10

7320

ld de,exp_a6

7321

ld bc,var48+6

7322

call mulSingle

7323

ld d,b

7324

ld e,c

7325

ld hl,exp_a5

7326

call addSingle

7327

ld hl,var48+10

7328

call mulSingle

7329

ld hl,exp_a4

7330

call addSingle

7331

ld hl,var48+10

7332

call mulSingle

7333

ld hl,exp_a3

7334

call addSingle

7335

ld hl,var48+10

7336

call mulSingle

7337

ld hl,exp_a2

7338

call addSingle

7339

ld hl,var48+10

7340

call mulSingle

7341

ld hl,exp_a1

7342

call addSingle

7343

ld hl,var48+10

7344

call mulSingle

7345

ld hl,const_1

7346

call addSingle

7347

ld hl,var48+9

7348

pop af

7349

add a,(hl)

7350

ld (hl),a

7351

ex de,hl

7352

pop de

7353

jp mov4

7354

exp_spec:

7355

;bit 6 means INF

7356

;bit 5 means NAN

7357

;no bits means zero

7358

;NAN -> NAN

7359

;+inf -> +inf

7360

;-inf -> +0 because lim approaches 0 from the right

7361

ld a,c

7362

add a,a

7363

jr z,exp_zero

7364

jp m,exp_inf

7365

;exp_NAN

7366

pop af

7367

ld de,0040h

7368

exp_return_spec:

7369

pop hl

7370

rr e

7371

ld (hl),a

7372

inc hl

7373

ld (hl),a

7374

inc hl

7375

ld (hl),e

7376

inc hl

7377

ld (hl),d

7378

ret

7379

exp_overflow:

7380

exp_inf:

7381

;+inf -> +inf

7382

;-inf -> +0 because lim approaches 0 from the right

7383

pop af

7384

sbc a,a ;FF if should be 0,

7385

cpl

7386

and 80h

7387

ld d,0

7388

ld e,a

7389

jr exp_return_spec

7390

exp_underflow:

7391

exp_zero:

7392

pop af

7393

or a

7394

ld de,$8000

7395

jr exp_return_spec

7396

7397

endif

7398

7399

;---------------------------------------------------------------------------------------------------------

7400

; sqrtSingle

7401

;---------------------------------------------------------------------------------------------------------

7402

7403

if defined MATH_SQR or defined MATH_EXP

7404

7405

;Uses 3 bytes at scrap

7406

sqrtSingle:

7407

;552+{0,19}+8{0,3+{0,3}}+pushpop+sqrtHLIX

7408

;min: 1784

7409

;max: 1987

7410

;avg: 1872

7411

call pushpop

7412

push bc

7413

ld c,(hl)

7414

inc hl

7415

ld e,(hl)

7416

inc hl

7417

ld a,(hl)

7418

add a,a

7419

jp c,sqrtSingle_NaN

7420

scf

7421

rra

7422

ld d,a

7423

inc hl

7424

ld a,(hl)

7425

or a

7426

jp z,sqrtSingle_special

7427

add a,80h

7428

rra

7429

push af ;new exponent

7430

jr c,_13

7431

srl d

7432

rr e

7433

rr c

7434

_13:

7435

ex de,hl

7436

ld ixh,c

7437

ld ixl,0

7438

call sqrtHLIX

7439

;AHL is the new remainder

7440

;Need to divide by 2, then divide by the 16-bit (var_x+4)

7441

rra

7442

ld a,h

7443

;HL/DE to 8 bits

7444

;We are just going to approximate it

7445

res 0,l

7446

jr c,$+5

7447

cp d

7448

jr c,$+4

7449

sub d

7450

inc l

7451

sla l

7452

rla

7453

jr c,$+5

7454

cp d

7455

jr c,$+4

7456

sub d

7457

inc l

7458

sla l

7459

rla

7460

jr c,$+5

7461

cp d

7462

jr c,$+4

7463

sub d

7464

inc l

7465

sla l

7466

rla

7467

jr c,$+5

7468

cp d

7469

jr c,$+4

7470

sub d

7471

inc l

7472

sla l

7473

rla

7474

jr c,$+5

7475

cp d

7476

jr c,$+4

7477

sub d

7478

inc l

7479

sla l

7480

rla

7481

jr c,$+5

7482

cp d

7483

jr c,$+4

7484

sub d

7485

inc l

7486

sla l

7487

rla

7488

jr c,$+5

7489

cp d

7490

jr c,$+4

7491

sub d

7492

inc l

7493

sla l

7494

rla

7495

jr c,$+5

7496

cp d

7497

jr c,$+4

7498

sub d

7499

inc l

7500

7501

pop bc

7502

ld a,l

7503

pop hl

7504

;BDEA

7505

ld (hl),a

7506

inc hl

7507

ld (hl),e

7508

inc hl

7509

res 7,d

7510

ld (hl),d

7511

inc hl

7512

ld (hl),b

7513

ret

7514

sqrtSingle_NaN:

7515

ld hl,const_NaN

7516

pop de

7517

jp mov4

7518

sqrtSingle_special:

7519

dec hl

7520

dec hl

7521

pop de

7522

jp mov4

7523

7524

sqrtHLIX:

7525

;Input: HLIX

7526

;Output: DE is the sqrt, AHL is the remainder

7527

;speed: 754+{0,1}+6{0,6}+{0,3+{0,18}}+{0,38}+sqrtHL

7528

;min: 1130

7529

;max: 1266

7530

;avg: 1190.5

7531

7532

7533

call sqrtHL

7534

add a,a

7535

ld e,a

7536

jr nc,_14

7537

inc d

7538

_14:

7539

7540

ld a,ixh

7541

sll e

7542

rl d

7543

add a,a

7544

adc hl,hl

7545

add a,a

7546

adc hl,hl

7547

sbc hl,de

7548

jr nc,_15

7549

add hl,de

7550

dec e

7551

jr _15a ;.db $FE ;start of `cp *`

7552

_15:

7553

inc e

7554

_15a:

7555

sll e

7556

rl d

7557

add a,a

7558

adc hl,hl

7559

add a,a

7560

adc hl,hl

7561

sbc hl,de

7562

jr nc,_16

7563

add hl,de

7564

dec e

7565

jr _16a ;.db $FE ;start of `cp *`

7566

_16:

7567

inc e

7568

_16a:

7569

sll e

7570

rl d

7571

add a,a

7572

adc hl,hl

7573

add a,a

7574

adc hl,hl

7575

sbc hl,de

7576

jr nc,_17

7577

add hl,de

7578

dec e

7579

jr _17a ;.db $FE ;start of `cp *`

7580

_17:

7581

inc e

7582

_17a:

7583

sll e

7584

rl d

7585

add a,a

7586

adc hl,hl

7587

add a,a

7588

adc hl,hl

7589

sbc hl,de

7590

jr nc,_18

7591

add hl,de

7592

dec e

7593

jr _18a ;.db $FE ;start of `cp *`

7594

_18:

7595

inc e

7596

_18a:

7597

;Now we have four more iterations

7598

;The first two are no problem

7599

ld a,ixl

7600

sll e

7601

rl d

7602

add a,a

7603

adc hl,hl

7604

add a,a

7605

adc hl,hl

7606

sbc hl,de

7607

jr nc,_19

7608

add hl,de

7609

dec e

7610

jr _19a ;.db $FE ;start of `cp *`

7611

_19:

7612

inc e

7613

_19a:

7614

sll e

7615

rl d

7616

add a,a

7617

adc hl,hl

7618

add a,a

7619

adc hl,hl

7620

sbc hl,de

7621

jr nc,_20

7622

add hl,de

7623

dec e

7624

jr _20a ;.db $FE ;start of `cp *`

7625

_20:

7626

inc e

7627

_20a:

7628

sqrt32_iter15:

7629

;On the next iteration, HL might temporarily overflow by 1 bit

7630

sll e

7631

rl d ;sla e \ rl d \ inc e

7632

add a,a

7633

adc hl,hl

7634

add a,a

7635

adc hl,hl ;This might overflow!

7636

jr c,sqrt32_iter15_br0

7637

;

7638

sbc hl,de

7639

jr nc,_21

7640

add hl,de

7641

dec e

7642

jr sqrt32_iter16

7643

sqrt32_iter15_br0:

7644

or a

7645

sbc hl,de

7646

_21:

7647

inc e

7648

7649

;On the next iteration, HL is allowed to overflow, DE could overflow with our current routine, but it needs to be shifted right at the end, anyways

7650

sqrt32_iter16:

7651

add a,a

7652

ld b,a ;either 0x00 or 0x80

7653

adc hl,hl

7654

rla

7655

adc hl,hl

7656

rla

7657

;AHL - (DE+DE+1)

7658

sbc hl,de

7659

sbc a,b

7660

inc e

7661

or a

7662

sbc hl,de

7663

sbc a,b

7664

ret p

7665

add hl,de

7666

adc a,b

7667

dec e

7668

add hl,de

7669

adc a,b

7670

ret

7671

7672

sqrtHL:

7673

;returns A as the sqrt, HL as the remainder, D = 0

7674

;min: 376cc

7675

;max: 416cc

7676

;avg: 393cc

7677

ld de,$5040

7678

ld a,h

7679

sub e

7680

jr nc,_22

7681

add a,e

7682

ld d,$10

7683

_22:

7684

sub d

7685

jr nc,_23

7686

add a,d

7687

jr _23a ;.db $01 ;start of ld bc,** which is 10cc to skip the next two bytes.

7688

_23:

7689

set 5,d

7690

_23a:

7691

res 4,d

7692

srl d

7693

7694

set 2,d

7695

sub d

7696

jr nc,_24

7697

add a,d

7698

jr _24a ;.db $01 ;start of ld bc,** which is 10cc to skip the next two bytes.

7699

_24:

7700

set 3,d

7701

_24a:

7702

res 2,d

7703

srl d

7704

7705

inc d

7706

sub d

7707

jr nc,_25

7708

add a,d

7709

dec d ;this resets the low bit of D, so `srl d` resets carry.

7710

jr _25a ;.db $06 ;start of ld b,* which is 7cc to skip the next byte.

7711

_25:

7712

inc d

7713

_25a:

7714

srl d

7715

ld h,a

7716

7717

7718

sbc hl,de

7719

ld a,e

7720

jr nc,_26

7721

add hl,de

7722

_26:

7723

ccf

7724

rra

7725

srl d

7726

rra

7727

ld e,a

7728

7729

sbc hl,de

7730

jr nc,_27

7731

add hl,de

7732

jr _27a ;.db $01 ;start of ld bc,** which is 10cc to skip the next two bytes.

7733

_27:

7734

or %00100000

7735

_27a:

7736

xor %00011000

7737

srl d

7738

rra

7739

ld e,a

7740

7741

7742

sbc hl,de

7743

jr nc,_28

7744

add hl,de

7745

jr _28a ;.db $01 ;start of ld bc,** which is 10cc to skip the next two bytes.

7746

_28:

7747

or %00001000

7748

_28a:

7749

xor %00000110

7750

srl d

7751

rra

7752

ld e,a

7753

sbc hl,de

7754

jr nc,_29

7755

add hl,de

7756

srl d

7757

rra

7758

ret

7759

_29:

7760

inc a

7761

srl d

7762

rra

7763

ret

7764

7765

endif

7766

7767

;---------------------------------------------------------------------------------------------------------

7768

; lnSingle

7769

;---------------------------------------------------------------------------------------------------------

7770

7771

if defined MATH_LOG or defined MATH_LN

7772

7773

lnSingle:

7774

; x / (1 + x/(2-x+4x/(3-2x+9x/(4-3x+16x/(5-4x)))))

7775

; a * x ^ (1/a) - a, where a = 100

7776

call pushpop

7777

push bc

7778

ld de, const_100_inv

7779

ld bc, temp

7780

call powSingle ; temp = x ^ (1/100)

7781

ld hl, temp

7782

ld de, const_100

7783

ld bc, temp1

7784

call mulSingle ; temp1 = temp * 100

7785

ld hl, temp1

7786

pop bc

7787

call subSingle ; bc = temp1 - 100

7788

ret

7789

7790

endif

7791

7792

;---------------------------------------------------------------------------------------------------------

7793

; logSingle

7794

;---------------------------------------------------------------------------------------------------------

7795

7796

if defined MATH_LOG

7797

7798

logSingle:

7799

call pushpop

7800

push bc

7801

ld bc, temp

7802

call lnSingle

7803

ld hl, temp

7804

ld de, const_lg10

7805

pop bc

7806

call divSingle

7807

ret

7808

7809

endif

7810

7811

;---------------------------------------------------------------------------------------------------------

7812

; expSingle

7813

;---------------------------------------------------------------------------------------------------------

7814

7815

if defined MATH_EXP

7816

7817

expSingle:

7818

;;Computes e^x

7819

;;HL points to x

7820

;;BC points to the output

7821

call pushpop

7822

ld de,const_lg_e

7823

push bc

7824

pow_inject:

7825

;;DE points to lg(y), HL points to x, BC points to output

7826

ld bc,var_x

7827

call mulSingle

7828

ld h,b

7829

ld l,c

7830

jp exp_inject

7831

7832

endif

7833

7834

;---------------------------------------------------------------------------------------------------------

7835

; sinSingle

7836

; https://en.wikipedia.org/wiki/List_of_trigonometric_identities

7837

; https://en.wikipedia.org/wiki/Taylor_series#Trigonometric_functions

7838

; https://cs.stackexchange.com/questions/89245/how-approximate-sine-using-taylor-series

7839

; https://stackoverflow.com/questions/42217069/approximating-sinex-with-a-taylor-series-in-c-and-having-a-lot-of-problems

7840

;---------------------------------------------------------------------------------------------------------

7841

7842

if defined MATH_SIN or defined MATH_TAN or defined MATH_COS

7843

7844

sinSingle:

7845

; taylor: x - x^3/6 + x^5/120 - x^7/5040

7846

; x(1 - x^2(1/6 - x^2(1/120 - x^2/5040)) )

7847

; reduction:

7848

; var_b = round( x / (2*PI), 0 )

7849

; var_c = x - var_b*2*PI

7850

; temp1 = if( var_c >= 0, var_c, var_c + 2*PI )

7851

; temp2 = if( temp1 > PI, temp1 - PI, temp1 )

7852

; var_a = if( temp2 > PI/2, PI - temp2, temp2 ) * if( temp1 > PI, -1, 1 )

7853

7854

call pushpop

7855

ld de, const_0

7856

call cmpSingle

7857

jr nz, sinSingle.1

7858

7859

call copySingle ; return 0

7860

ret

7861

7862

sinSingle.1:

7863

call trigRangeReductionSinCos

7864

push bc

7865

ld hl, var_a

7866

ld de, var_a

7867

ld bc, var_b

7868

call mulSingle ; var_b = var_a * var_a

7869

ld hl, var_b

7870

ld de, sin_a3

7871

ld bc, temp

7872

call mulSingle ; temp = x^2/5040

7873

ld hl, sin_a2

7874

ld de, temp

7875

ld bc, temp1

7876

call subSingle ; temp1 = 1/120 - temp

7877

ld hl, var_b

7878

ld de, temp1

7879

ld bc, temp

7880

call mulSingle ; temp = x^2 * temp1

7881

ld hl, sin_a1

7882

ld de, temp

7883

ld bc, temp1

7884

call subSingle ; temp1 = 1/6 - temp

7885

ld hl, var_b

7886

ld de, temp1

7887

ld bc, temp

7888

call mulSingle ; temp = x^2 * temp1

7889

ld hl, const_1

7890

ld de, temp

7891

ld bc, temp1

7892

call subSingle ; temp1 = 1 - temp

7893

ld hl, var_a

7894

ld de, temp1

7895

pop bc

7896

call mulSingle ; return x * temp1

7897

ret

7898

7899

trigRangeReductionSinCos:

7900

call pushpop

7901

push hl

7902

; var_b = round( x / (2*PI), 0 )

7903

ld de, const_2pi

7904

ld bc, var_c

7905

call divSingle

7906

ld hl, var_c

7907

ld de, 0

7908

ld bc, var_b

7909

call roundSingle

7910

; var_c = x - var_b*2*PI

7911

ld hl, var_b

7912

ld de, const_2pi

7913

ld bc, temp

7914

call mulSingle ; temp = var_b*2*PI

7915

pop hl

7916

ld de, temp

7917

ld bc, var_c

7918

call subSingle ; var_c = x - temp

7919

; temp1 = if( var_c >= 0, var_c, var_c + 2*PI )

7920

ld hl, var_c

7921

ld de, const_0

7922

call cmpSingle

7923

jr nc, trigRangeReductionSinCos.else.2

7924

ld hl, var_c

7925

ld bc, temp1

7926

call copySingle ; temp1 = var_c

7927

jr trigRangeReductionSinCos.endif.2

7928

trigRangeReductionSinCos.else.2:

7929

ld hl, var_c

7930

ld de, const_2pi

7931

ld bc, temp1

7932

call addSingle ; temp1 = var_c + 2*PI

7933

trigRangeReductionSinCos.endif.2:

7934

; temp2 = if( temp1 > PI, temp1 - PI, temp1 )

7935

ld hl, const_pi

7936

ld de, temp1

7937

call cmpSingle

7938

jr c, trigRangeReductionSinCos.else.3

7939

jr z, trigRangeReductionSinCos.else.3

7940

ld hl, temp1

7941

ld de, const_pi

7942

ld bc, temp2

7943

call subSingle ; temp2

7944

jr trigRangeReductionSinCos.endif.3

7945

trigRangeReductionSinCos.else.3:

7946

ld hl, temp1

7947

ld bc, temp2

7948

call copySingle ; temp2 = temp1

7949

trigRangeReductionSinCos.endif.3:

7950

; var_a = if( temp2 > PI/2, PI - temp2, temp2 ) * if( temp1 > PI, -1, 1 )

7951

ld hl, const_half_pi

7952

ld de, temp2

7953

call cmpSingle

7954

jr c, trigRangeReductionSinCos.else.4

7955

jr z, trigRangeReductionSinCos.else.4

7956

ld hl, const_pi

7957

ld de, temp2

7958

ld bc, var_a

7959

call subSingle ; var_a

7960

jr trigRangeReductionSinCos.endif.4

7961

trigRangeReductionSinCos.else.4:

7962

ld hl, temp2

7963

ld bc, var_a

7964

call copySingle ; var_a = temp2

7965

trigRangeReductionSinCos.endif.4:

7966

; if( temp > PI, -1, 1 )

7967

ld hl, temp1

7968

ld de, const_pi

7969

call cmpSingle

7970

jr nc, trigRangeReductionSinCos.endif.5

7971

ld ix, var_a

7972

ld a, (ix+2)

7973

set 7, a

7974

ld (ix+2), a ; turn var_a to negative

7975

trigRangeReductionSinCos.endif.5:

7976

; return var_a

7977

ret

7978

7979

endif

7980

7981

;---------------------------------------------------------------------------------------------------------

7982

; cosSingle

7983

;---------------------------------------------------------------------------------------------------------

7984

7985

if defined MATH_COS or defined MATH_TAN

7986

7987

cosSingle:

7988

; taylor: 1 - x^2/2 + x^4/24 - x^6/720

7989

; 1 - x^2(1/2 - x^2(1/24 - x^2/720) )

7990

; reduction: same as sin

7991

; cos = cos * sign

7992

7993

call pushpop

7994

ld de, const_0

7995

call cmpSingle

7996

jr nz, cosSingle.1

7997

7998

ld hl, const_1

7999

call copySingle ; return 1

8000

ret

8001

8002

cosSingle.1:

8003

; 1 - x^2(1/2 - x^2(1/24 - x^2/720) )

8004

call trigRangeReductionSinCos

8005

push bc

8006

ld hl, var_a

8007

ld de, var_a

8008

ld bc, var_b

8009

call mulSingle ; var_b = var_a * var_a

8010

ld hl, var_b

8011

ld de, cos_a3

8012

ld bc, temp

8013

call mulSingle ; temp = x^2/720

8014

ld hl, cos_a2

8015

ld de, temp

8016

ld bc, temp1

8017

call subSingle ; temp1 = 1/24 - temp

8018

ld hl, var_b

8019

ld de, temp1

8020

ld bc, temp

8021

call mulSingle ; temp = x^2 * temp1

8022

ld hl, cos_a1

8023

ld de, temp

8024

ld bc, temp1

8025

call subSingle ; temp1 = 1/2 - temp

8026

ld hl, var_b

8027

ld de, temp1

8028

ld bc, temp

8029

call mulSingle ; temp = x^2 * temp1

8030

ld hl, const_1

8031

ld de, temp

8032

ld bc, temp1

8033

call subSingle ; temp1 = 1 - temp

8034

8035

; temp3 = abs(var_c)

8036

; temp1 = temp1 * if( temp3 >= PI/2, -1, 1 ) ==> cos sign

8037

ld hl, var_c

8038

ld bc, temp3

8039

call copySingle

8040

ld ix, temp3

8041

ld a, (ix+2)

8042

res 7, a

8043

ld (ix+2), a ; temp3 = abs(var_c)

8044

ld hl, temp3

8045

ld de, const_half_pi

8046

call cmpSingle ; if temp3 >= PI/2 then temp1 = -temp1

8047

jr nc, cosSingle.endif.1

8048

ld ix, temp1

8049

ld a, (ix+2)

8050

set 7, a

8051

ld (ix+2), a ; temp1 = -temp1

8052

cosSingle.endif.1:

8053

pop bc

8054

ld hl, temp1

8055

call copySingle ; return temp1

8056

ret

8057

8058

endif

8059

8060

;---------------------------------------------------------------------------------------------------------

8061

; tanSingle

8062

;---------------------------------------------------------------------------------------------------------

8063

8064

if defined MATH_TAN

8065

8066

tanSingle:

8067

call pushpop

8068

push bc

8069

;HL points to input

8070

ld bc,var_z

8071

ld d,b

8072

ld e,c

8073

call cosSingle

8074

ld bc,var_x

8075

call sinSingle

8076

ld h,b

8077

ld l,c

8078

pop bc

8079

jp divSingle

8080

8081

endif

8082

8083

;---------------------------------------------------------------------------------------------------------

8084

; atanSingle

8085

;---------------------------------------------------------------------------------------------------------

8086

8087

if defined MATH_ATN

8088

8089

atanSingle:

8090

;taylor: x/(1 + x^2/(3 + (2*x)^2/(5 + (3*x)^2/(7+(4*x)^2/9) ) ) )

8091

; x < -1: atan - PI/2

8092

; x >= 1: PI/2 - atan

8093

;reduction: abs(X) > 1 : Y = 1 / X

8094

; abs(X) <= 1: Y = X

8095

; X < 0: Y = -Y

8096

8097

call pushpop

8098

ld de, const_0

8099

call cmpSingle

8100

jr nz, atanSingle.1

8101

8102

ld hl, const_0

8103

call copySingle ; return 0

8104

ret

8105

8106

atanSingle.1:

8107

;x/(1 + x^2/(3 + (2*x)^2/(5 + (3*x)^2/(7+(4*x)^2/9) ) ) )

8108

call trigRangeReductionAtan

8109

push bc

8110

push hl

8111

ld hl, var_a

8112

ld de, var_a

8113

ld bc, var_b

8114

call mulSingle ; var_b = var_a * var_a

8115

ld hl, var_b

8116

ld de, const_16

8117

ld bc, temp

8118

call mulSingle ; temp = (4*x)^2

8119

ld hl, temp

8120

ld de, const_9

8121

ld bc, temp1

8122

call divSingle ; temp1 = temp/9

8123

ld hl, temp1

8124

ld de, const_7

8125

ld bc, temp

8126

call addSingle ; temp = 7 + temp1

8127

ld hl, var_b

8128

ld de, const_9

8129

ld bc, temp1

8130

call mulSingle ; temp1 = var_b * 9

8131

ld hl, temp1

8132

ld de, temp

8133

ld bc, temp2

8134

call divSingle ; temp2 = temp1 / temp

8135

ld hl, temp2

8136

ld de, const_5

8137

ld bc, temp

8138

call addSingle ; temp = 5 + temp2

8139

ld hl, var_b

8140

ld de, const_4

8141

ld bc, temp1

8142

call mulSingle ; temp1 = var_b * 4

8143

ld hl, temp1

8144

ld de, temp

8145

ld bc, temp2

8146

call divSingle ; temp2 = temp1 / temp

8147

ld hl, temp2

8148

ld de, const_3

8149

ld bc, temp

8150

call addSingle ; temp = 3 + temp2

8151

ld hl, var_b

8152

ld de, temp

8153

ld bc, temp2

8154

call divSingle ; temp2 = var_b / temp

8155

ld hl, temp2

8156

ld de, const_1

8157

ld bc, temp

8158

call addSingle ; temp = 1 + temp2

8159

ld hl, var_a

8160

ld de, temp

8161

ld bc, temp2

8162

call divSingle ; temp2 = var_a / temp

8163

pop hl

8164

; x >= 1: PI/2 - atan

8165

ld de, const_1

8166

call cmpSingle

8167

jr nc, atanSingle.2

8168

ld hl, const_half_pi

8169

ld de, temp2

8170

ld bc, temp

8171

call subSingle

8172

ld hl, temp

8173

jr atanSingle.4

8174

atanSingle.2:

8175

; x < -1: atan - PI/2

8176

push hl

8177

ld hl, const_0

8178

ld de, const_1

8179

ld bc, temp

8180

call subSingle

8181

pop hl

8182

ld de, temp

8183

call cmpSingle

8184

jr c, atanSingle.3

8185

ld hl, temp2

8186

ld de, const_half_pi

8187

ld bc, temp

8188

call subSingle

8189

ld hl, temp

8190

jr atanSingle.4

8191

atanSingle.3:

8192

ld hl, temp2

8193

atanSingle.4:

8194

pop bc

8195

call copySingle ; return temp2

8196

ret

8197

8198

trigRangeReductionAtan:

8199

;reduction: abs(X) > 1 : Y = 1 / X

8200

; abs(X) <= 1: Y = X

8201

; X < 0: Y = -Y

8202

call pushpop

8203

push hl

8204

ld bc, temp

8205

call copySingle

8206

ld ix, temp

8207

ld a, (ix+2)

8208

res 7, a

8209

ld (ix+2), a ; abs(x)

8210

ld hl, temp

8211

ld de, const_1

8212

call cmpSingle

8213

jr nc, trigRangeReductionAtan.1

8214

ld hl, const_1

8215

pop de

8216

push de

8217

ld bc, var_a

8218

call divSingle

8219

jr trigRangeReductionAtan.2

8220

trigRangeReductionAtan.1:

8221

pop hl

8222

push hl

8223

ld bc, var_a

8224

call copySingle

8225

trigRangeReductionAtan.2:

8226

pop hl

8227

ld de, const_0

8228

call cmpSingle

8229

jr c, trigRangeReductionAtan.3

8230

ld ix, var_a

8231

ld a, (ix+2)

8232

set 7, a

8233

ld (ix+2), a ; y = -y

8234

trigRangeReductionAtan.3:

8235

ret

8236

8237

endif

8238

8239

if defined MATH_SIN or defined MATH_TAN or defined MATH_COS

8240

8241

;---------------------------------------------------------------------------------------------------------

8242

; copySingle

8243

;---------------------------------------------------------------------------------------------------------

8244

8245

copySingle:

8246

call pushpop

8247

;push bc

8248

;pop de

8249

ld d, b

8250

ld e, c

8251

ldi

8252

ldi

8253

ldi

8254

ldi

8255

ret

8256

8257

;---------------------------------------------------------------------------------------------------------

8258

; roundSingle

8259

;---------------------------------------------------------------------------------------------------------

8260

8261

roundSingle:

8262

call pushpop

8263

call copySingle

8264

;push bc

8265

;pop hl

8266

ld h, b

8267

ld l, c

8268

push de

8269

ld a, e

8270

ld de, const_10

8271

roundSingle.1:

8272

or 0

8273

jr z, roundSingle.2

8274

ld bc, temp

8275

call mulSingle

8276

;push hl

8277

;pop bc

8278

ld b, h

8279

ld c, l

8280

ld hl, temp

8281

call copySingle

8282

;push bc

8283

;pop hl

8284

ld h, b

8285

ld l, c

8286

dec a

8287

jr roundSingle.1

8288

roundSingle.2:

8289

ld de, const_half_1

8290

ld bc, temp

8291

call addSingle

8292

push hl

8293

ld hl, temp

8294

ld bc, temp1

8295

call single2Int

8296

ld hl, temp1

8297

pop bc

8298

call int2Single

8299

;push bc

8300

;pop hl

8301

ld h, b

8302

ld l, c

8303

pop de

8304

ld a, e

8305

ld de, const_10

8306

roundSingle.3:

8307

or 0

8308

jr z, roundSingle.4

8309

ld bc, temp

8310

call divSingle

8311

;push hl

8312

;pop bc

8313

ld b, h

8314

ld c, l

8315

ld hl, temp

8316

call copySingle

8317

;push bc

8318

;pop hl

8319

ld h, b

8320

ld l, c

8321

dec a

8322

jr roundSingle.3

8323

roundSingle.4:

8324

ret

8325

8326

endif

8327

8328

if defined MATH_ABSFN

8329

8330

;---------------------------------------------------------------------------------------------------------

8331

; absSingle

8332

;---------------------------------------------------------------------------------------------------------

8333

8334

absSingle:

8335

;;HL points to the float

8336

;;BC points to where to output the result

8337

call pushpop

8338

ld d,b

8339

ld e,c

8340

ldi

8341

ldi

8342

ld a,(hl)

8343

and %01111111

8344

ld (de),a

8345

inc hl

8346

inc de

8347

ld a,(hl)

8348

ld (de),a

8349

ret

8350

8351

endif

8352

8353

if defined MATH_SGN

8354

8355

;---------------------------------------------------------------------------------------------------------

8356

; sgnSingle

8357

;---------------------------------------------------------------------------------------------------------

8358

8359

sgnSingle:

8360

;;HL points to the float

8361

;;BC points to where to output the result

8362

jp negSingle

8363

8364

endif

8365

8366

if defined powSingle or defined sgnSingle or defined MATH_NEG

8367

8368

;---------------------------------------------------------------------------------------------------------

8369

; negSingle

8370

;---------------------------------------------------------------------------------------------------------

8371

8372

negSingle:

8373

;;HL points to the float

8374

;;BC points to where to output the result

8375

call pushpop

8376

push hl

8377

pop ix

8378

ld a, (ix+3)

8379

or 0

8380

jr nz, negSingle.test.sign

8381

ld a, (ix+2)

8382

or 0

8383

jr nz, negSingle.test.sign

8384

ld a, (ix+1)

8385

or 0

8386

jr nz, negSingle.test.sign

8387

ld a, (ix)

8388

or 0

8389

jr nz, negSingle.test.sign

8390

;push bc

8391

;pop de

8392

ld d, b

8393

ld e, c

8394

ld hl, const_0

8395

ldi

8396

ldi

8397

ldi

8398

ldi

8399

ret

8400

negSingle.test.sign:

8401

ld a, (ix+2)

8402

bit 7, a

8403

jr z, negSingle.positive

8404

negSingle.negative:

8405

push bc

8406

pop ix

8407

call negSingle.positive

8408

ld a, (ix+2)

8409

set 7, a

8410

ld (ix+2), a

8411

ret

8412

negSingle.positive:

8413

;push bc

8414

;pop de

8415

ld d, b

8416

ld e, c

8417

ld hl, const_1

8418

ldi

8419

ldi

8420

ldi

8421

ldi

8422

ret

8423

8424

endif

8425

8426

if defined MATH_DCOMP or defined MATH.POW or defined MATH_EXP or defined MATH_LOG or defined MATH_LN or defined MATH_SIN or defined MATH_TAN or defined MATH_COS or defined MATH_ATN

8427

8428

;---------------------------------------------------------------------------------------------------------

8429

; cmpSingle

8430

;---------------------------------------------------------------------------------------------------------

8431

8432

cmpSingle:

8433

;Input: HL points to float1, DE points to float2

8434

;Output:

8435

; float1 >= float2 : nc

8436

; float1 < float2 : c,nz

8437

; float1 == float2 : z

8438

; There is a margin of error allowed in the lower 2 bits of the mantissa.

8439

;

8440

;Currently fails when both numbers have magnitude less than about 2^-106

8441

push hl

8442

push de

8443

push bc

8444

ld c, a

8445

push bc

8446

ex de, hl

8447

call _30

8448

pop bc

8449

ld a, c

8450

pop bc

8451

pop de

8452

pop hl

8453

ret

8454

_30:

8455

inc de

8456

inc de

8457

inc de

8458

ld a,(de)

8459

inc hl

8460

inc hl

8461

inc hl

8462

cp (hl)

8463

jr nc,_31

8464

ld a,(hl)

8465

_31:

8466

dec hl

8467

dec hl

8468

dec hl

8469

dec de

8470

dec de

8471

dec de

8472

push af

8473

ld bc,scrap

8474

call subSingle

8475

ld a,(scrap+3) ;new power

8476

pop bc ;B is old power

8477

or a

8478

jr z,cmp_close

8479

sub b

8480

jr nc,cmp_is_sign

8481

dec a

8482

add a,22

8483

jr nc,cmp_close

8484

cmp_is_sign:

8485

ld a,(scrap+2)

8486

or 1 ;not equal, so reset z flag

8487

rla ;if negative, float1<float2, setting c flag as wanted, else nc.

8488

ret

8489

cmp_close:

8490

xor a

8491

ret

8492

8493

endif

8494

8495

if defined MATH_RND

8496

8497

;---------------------------------------------------------------------------------------------------------

8498

; randSingle

8499

;---------------------------------------------------------------------------------------------------------

8500

8501

randSingle:

8502

;Stores a pseudo-random number on [0,1)

8503

;it won't produce values on (0,2^-23)

8504

call pushpop

8505

push bc

8506

call rand

8507

push hl

8508

call rand

8509

pop de

8510

ex de,hl

8511

ld bc,$207F

8512

;DEHL is the mantissa, B is the exponent

8513

ld a,d

8514

or a

8515

jp m,rand_normed

8516

_32:

8517

dec c

8518

add hl,hl

8519

rl e

8520

rl d

8521

jp m,rand_normed

8522

djnz _32

8523

rand_zero:

8524

ld c,l

8525

ld b,l

8526

jr rand_done

8527

rand_normed:

8528

;If we needed to shift more than 8 bits, we'll load in more random data

8529

ld a,b

8530

cp 8

8531

jr c,rand_zero

8532

sub 24

8533

jp nc,rand_no_more_rand_data

8534

push bc

8535

push de

8536

call rand

8537

pop de

8538

ld e,h

8539

ld h,l

8540

pop bc

8541

rand_no_more_rand_data:

8542

ld b,e

8543

ld e,d

8544

ld d,c

8545

ld c,h

8546

res 7,e

8547

rand_done:

8548

pop hl

8549

;DEBC

8550

ld (hl),b

8551

inc hl

8552

ld (hl),c

8553

inc hl

8554

ld (hl),e

8555

inc hl

8556

ld (hl),d

8557

ret

8558

8559

rand:

8560

;;Tested and passes all CAcert tests

8561

;;Uses a very simple 32-bit LCG and 32-bit LFSR

8562

;;it has a period of 18,446,744,069,414,584,320

8563

;;roughly 18.4 quintillion.

8564

;;LFSR taps: 0,2,6,7 = 11000101

8565

;;323cc

8566

;;Thanks to Runer112 for his help on optimizing the LCG and suggesting to try the much simpler LCG. On their own, the two are terrible, but together they are great.

8567

;Uses 64 bits of state

8568

ld hl,(seed0)

8569

ld de,(seed0+2)

8570

ld b,h

8571

ld c,l

8572

add hl,hl

8573

rl e

8574

rl d

8575

add hl,hl

8576

rl e

8577

rl d

8578

inc l

8579

add hl,bc

8580

ld (seed0),hl

8581

ld hl,(seed0+2)

8582

adc hl,de

8583

ld (seed0+2),hl

8584

ex de,hl

8585

;;lfsr

8586

ld hl,(seed1)

8587

ld bc,(seed1+2)

8588

add hl,hl

8589

rl c

8590

rl b

8591

ld (seed1+2),bc

8592

sbc a,a

8593

and %11000101

8594

xor l

8595

ld l,a

8596

ld (seed1),hl

8597

ex de,hl

8598

add hl,bc

8599

ret

8600

8601

endif

8602

8603

if defined MATH_FOUT

8604

8605

;---------------------------------------------------------------------------------------------------------

8606

; single2Str

8607

; in HL = Single address

8608

; BC = String address

8609

; out A = String size

8610

; http://0x80.pl/notesen/2015-12-29-float-to-string.html

8611

; http://0x80.pl/articles/convert-float-to-integer.html

8612

;---------------------------------------------------------------------------------------------------------

8613

8614

single2str:

8615

call pushpop

8616

push bc

8617

call _33

8618

pop de

8619

xor a

8620

cp (hl)

8621

ldi

8622

jr nz,$-3

8623

8624

ret

8625

_33:

8626

; Move the float to scrap

8627

ld de,scrap

8628

call mov4

8629

8630

; Make the float negative, write a '-' if already negative

8631

ld de,strout_single

8632

ld hl,scrap+2

8633

ld a,(hl)

8634

;rlca

8635

;scf

8636

;rra

8637

bit 7, a

8638

jr z, _34

8639

ld a,'-' ; write '-' simbol

8640

ld (de),a

8641

inc de

8642

ld a,(hl)

8643

_34:

8644

set 7, a

8645

ld (hl),a

8646

8647

; Check if the exponent field is 0 (a special value)

8648

inc hl

8649

ld a,(hl)

8650

or a

8651

jp z,strcase_single

8652

8653

8654

; We should write '0' next. When rounding 9.999999... for example, not padding with a 0 will return '.' instead of '1.'

8655

ex de,hl

8656

ld (hl),'0'

8657

inc hl

8658

8659

; Save the pointer

8660

push hl

8661

8662

; Now we need to perform signed (A-128)*77 (approximation of exponent*log10(2))

8663

ld de,77

8664

ld h,a

8665

ld l,d

8666

call mul8_preset

8667

ld de,-77*128

8668

add hl,de

8669

ld a,h

8670

ld (pow10exp_single),a ;The base-10 exponent

8671

ld de,pown10LUT

8672

jr c,_35

8673

neg

8674

ld de,pow10LUT ;get the table of 10^-(2^k)

8675

_35:

8676

ld hl, pow10exp_single

8677

ld bc,scrap

8678

call singletostr_mul

8679

call singletostr_mul

8680

call singletostr_mul

8681

call singletostr_mul

8682

call singletostr_mul

8683

call singletostr_mul

8684

;now the number is pretty close to a nice value

8685

8686

; If it is less than 1, multiply by 10

8687

ld a,(scrap+3)

8688

sub 128

8689

jr nc,_36

8690

ld de,const_10

8691

;ld hl,scrap ;Since singletostr_mul returns BC = scrap, can do this cheaper

8692

;ld b,h

8693

;ld c,l

8694

ld h,b

8695

ld l,c

8696

call mulSingle

8697

ld hl,pow10exp_single

8698

dec (hl)

8699

ld a,(scrap+3)

8700

sub 128

8701

_36:

8702

8703

; Convert to a fixed-point number !

8704

inc a

8705

ld b,a

8706

xor a

8707

_37:

8708

ld hl,scrap

8709

sla (hl)

8710

inc hl

8711

rl (hl)

8712

inc hl

8713

rl (hl)

8714

rla

8715

djnz _37

8716

8717

;We need to get 7 digits

8718

ld b,6

8719

pop hl ;Points to the string

8720

8721

;The first digit can be as large as 20, so it'll actually be two digits

8722

cp 10

8723

jr c,_38

8724

dec b

8725

;Increment the exponent :)

8726

ld de,(pow10exp_single-1)

8727

inc d

8728

ld (pow10exp_single-1),de

8729

;

8730

ld (hl),'0'-1

8731

inc (hl)

8732

sub 10

8733

jr nc,$-3

8734

add a,10

8735

inc hl

8736

_38:

8737

; Get the remaining digits.

8738

_39:

8739

add a,'0'

8740

ld (hl),a

8741

inc hl

8742

push hl

8743

push bc

8744

call singletostrmul10

8745

pop bc

8746

pop hl

8747

djnz _39

8748

8749

;Save the pointer to the end of the string

8750

ld d,h

8751

ld e,l

8752

;ld (hl), 0

8753

8754

;Now let's round!

8755

cp 5

8756

jr c,rounding_done_single

8757

jr _40a ;.db $DA ;start of `jp c,*` in order to skip the next instruction

8758

_40:

8759

ld (hl),'0'

8760

_40a:

8761

dec hl

8762

inc (hl)

8763

ld a,(hl)

8764

cp $3A

8765

jr z,_40

8766

rounding_done_single:

8767

8768

8769

;Strip the leading zero if it exists (rounding may have bumped this to `1`)

8770

ld hl,strout_single

8771

ld a,(hl)

8772

cp '-'

8773

jr nz,_41

8774

inc hl

8775

ld a,(hl)

8776

_41:

8777

cp '0'

8778

jr nz,_42

8779

dec de

8780

ex de,hl

8781

;Now lets move HL-DE bytes at DE+1 to DE

8782

sbc hl,de

8783

ld b,h

8784

ld c,l

8785

ld h,d

8786

ld l,e

8787

inc hl

8788

ldir

8789

cp a

8790

_42:

8791

8792

push de

8793

;If z flag is reset, this means that the exponent should be bumped up 1

8794

ld a,(pow10exp_single)

8795

jr z,_43

8796

inc a

8797

ld (pow10exp_single),a

8798

_43:

8799

8800

;if -4<=A<=6, then need to insert the decimal place somewhere.

8801

add a,4

8802

cp 10

8803

jp c,movdec_single

8804

_44:

8805

;for this, we need to insert the decimal after the first digit

8806

;Then, we need to append the exponent string

8807

ld hl,strout_single

8808

ld de,strout_single-1

8809

ld a,(hl)

8810

cp '-' ;negative sign

8811

jr nz,_45

8812

ldi

8813

_45:

8814

ldi

8815

ld a,'.'

8816

ld (de),a

8817

8818

;remove any stray zeroes at the end before appending the exponent

8819

pop hl

8820

call strip_zeroes

8821

8822

; Write the exponent

8823

ld (hl),'e'

8824

inc hl

8825

ld a,(pow10exp_single)

8826

or a

8827

jp p,_46

8828

ld (hl),'-' ;negative sign

8829

inc hl

8830

neg

8831

_46:

8832

cp 10

8833

jr c,_47

8834

ld (hl),'0'-1

8835

inc (hl)

8836

sub 10

8837

jr nc,$-3

8838

add a,10

8839

inc hl

8840

_47:

8841

add a,'0'

8842

ld (hl),a

8843

inc hl

8844

ld (hl),0

8845

8846

ld de, strout_single

8847

xor a

8848

sbc hl, de

8849

ld a, l ; string size

8850

8851

ld hl,strout_single-1

8852

ret

8853

8854

movdec_single:

8855

ld a,(pow10exp_single)

8856

or a

8857

jp p,posdec_single

8858

ld l,a

8859

;need to put zeroes before everything

8860

ld de,strout_single

8861

ld a,(de)

8862

cp '-' ;negative sign

8863

push af

8864

ld a,'0'

8865

jr z,$+3

8866

_48:

8867

dec de

8868

ld (de),a

8869

inc l

8870

jr nz,_48

8871

_49:

8872

ex de,hl

8873

ld (hl),'.'

8874

pop af

8875

jr nz,_50

8876

dec hl

8877

ld (hl),a

8878

_50:

8879

ex de,hl

8880

pop hl

8881

call strip_zeroes

8882

ld (hl),0

8883

ex de,hl

8884

ret

8885

8886

posdec_single:

8887

ld hl,strout_single

8888

ld de,strout_single-1

8889

ld c,a

8890

ld a,(hl)

8891

ld b,0

8892

cp '-' ;negative sign

8893

jr nz,_51

8894

inc c

8895

_51:

8896

inc c

8897

ldir

8898

ld a,'.'

8899

ld (de),a

8900

pop hl

8901

call strip_zeroes

8902

ld (hl),0

8903

ld hl,strout_single-1

8904

ret

8905

8906

strcase_single:

8907

ld hl,str_Zero

8908

ld a,(scrap+2)

8909

add a,a

8910

and $C0

8911

jr z,_52

8912

ld hl,str_Inf

8913

jp pe,_52

8914

ld hl,str_NaN

8915

_52:

8916

call mov4

8917

ld hl,strout_single

8918

ret

8919

8920

singletostrmul10:

8921

;multiply the 0.24 fixed point number at scrap by 10

8922

;overflow in A register

8923

ld a,(scrap+2)

8924

ld e,a

8925

ld hl,(scrap)

8926

xor a

8927

ld d,e

8928

ld b,h

8929

ld c,l

8930

add hl,hl

8931

rl d

8932

rla

8933

add hl,hl

8934

rl d

8935

rla

8936

add hl,bc

8937

ld b,a

8938

ld a,d

8939

adc a,e

8940

ld d,a

8941

ld a,b

8942

adc a,0

8943

add hl,hl

8944

rl d

8945

rla

8946

ld (scrap+1),de

8947

ld (scrap),hl

8948

ret

8949

8950

strip_zeroes:

8951

ld a,'0'

8952

_53:

8953

dec hl

8954

cp (hl)

8955

jr z,_53

8956

8957

;Check that the last digit isn't a decimal!

8958

ld a,'.'

8959

cp (hl)

8960

ret z

8961

inc hl

8962

ret

8963

8964

singletostr_mul:

8965

rra

8966

call c,_54

8967

ld hl,4

8968

add hl,de

8969

ex de,hl

8970

ret

8971

_54:

8972

ld h,b

8973

ld l,c

8974

jp mulSingle

8975

mul8:

8976

;H*E => HL

8977

ld l,0

8978

ld d,l

8979

mul8_preset:

8980

sla h

8981

jr nc,$+3

8982

ld l,e

8983

add hl,hl

8984

jr nc,$+3

8985

add hl,de

8986

add hl,hl

8987

jr nc,$+3

8988

add hl,de

8989

add hl,hl

8990

jr nc,$+3

8991

add hl,de

8992

add hl,hl

8993

jr nc,$+3

8994

add hl,de

8995

add hl,hl

8996

jr nc,$+3

8997

add hl,de

8998

add hl,hl

8999

jr nc,$+3

9000

add hl,de

9001

add hl,hl

9002

ret nc

9003

add hl,de

9004

ret

9005

9006

endif

9007

9008

9009

if defined MATH_FIN

9010

9011

;---------------------------------------------------------------------------------------------------------

9012

; str2Single

9013

; https://www.ticalc.org/pub/86/asm/source/routines/atof.asm

9014

;---------------------------------------------------------------------------------------------------------

9015

9016

char_NEG: equ '-'

9017

char_ENG: equ ','

9018

char_DEC: equ '.'

9019

ptr_sto: equ scrap+9

9020

9021

;;#Routines/Single Precision

9022

;;Inputs:

9023

;; HL points to the string

9024

;; BC points to where the float is output

9025

;;Output:

9026

;; scrap+9 is the pointer to the end of the string

9027

;;Destroys:

9028

;; 11 bytes at scrap ?

9029

9030

str2single:

9031

call pushpop

9032

push bc

9033

;Check if there is a negative sign.

9034

; Save for later

9035

; Advance ptr

9036

ld a,(hl)

9037

sub char_NEG

9038

sub 1

9039

push af

9040

jr nc,$+3

9041

inc hl

9042

;Skip all leading zeroes

9043

ld a,(hl)

9044

cp '0'

9045

jr z,$-4 ;jumps back to the `inc hl`

9046

;Set exponent to 0

9047

ld b,0

9048

;Check if the next char is char_DEC

9049

sub char_DEC

9050

or a ;to reset the carry flag

9051

jr nz,_55

9052

jr _54a ;.db $FE ;start of cp *

9053

;Get rid of zeroes

9054

dec b

9055

_54a:

9056

inc hl

9057

ld a,(hl)

9058

cp '0'

9059

jr z,$-5 ;jumps back to the `dec b`

9060

scf

9061

_55:

9062

;Now we read in the next 8 digits

9063

ld de,scrap+3

9064

call ascii_to_uint8

9065

call ascii_to_uint8

9066

call ascii_to_uint8

9067

call ascii_to_uint8

9068

;Now `scrap` holds the 4-digit base-100 number.

9069

;b is the exponent

9070

;if carry flag is set, just need to get rid of remaining digits

9071

;Otherwise, need to get rid of remaining digits, while incrementing the exponent

9072

sbc a,a

9073

inc a

9074

ld c,a

9075

_56:

9076

ld a,(hl)

9077

cp 30h

9078

jr nz,_57

9079

inc hl

9080

ld a,b

9081

add a,c

9082

jp z,strToSingle_inf

9083

ld b,a

9084

jr _56

9085

;Now check for engineering `E` to modify the exponent

9086

_57:

9087

cp char_NEG

9088

call z,str_eng_exp

9089

;Gotta multiply the number at (scrap) by 2^24

9090

ld (ptr_sto),hl

9091

ld d,100

9092

call scrap_times_256

9093

ld a,c

9094

ld (scrap+6),a

9095

call scrap_times_256

9096

ld a,c

9097

ld (scrap+5),a

9098

call scrap_times_256

9099

ld a,c

9100

ld (scrap+4),a

9101

call scrap_times_256

9102

ld a,c

9103

ld (scrap+3),a

9104

;Now scrap+3 is a 4-byte mantissa that needs to be normalized

9105

;

9106

ld hl,(scrap+3)

9107

ld a,h

9108

or l

9109

ld hl,(scrap+5)

9110

or l

9111

or h

9112

jp z,strToSingle_zero-1

9113

ld c,$7F

9114

ld a,h

9115

or a

9116

jp m,strToSingle_normed

9117

;Will need to iterate at most three times

9118

_58:

9119

dec c

9120

ld hl,scrap+3

9121

sla (hl)

9122

inc hl

9123

rl (hl)

9124

inc hl

9125

rl (hl)

9126

inc hl

9127

adc a,a

9128

jp p,_58

9129

strToSingle_normed:

9130

;Move the number to scrap

9131

ld hl,(scrap+4)

9132

ld (scrap),hl

9133

ld l,a

9134

ld h,c

9135

sla l

9136

pop af

9137

rr l

9138

ld (scrap+2),hl

9139

;now (scrap) is our number, need to multiply by power of 10!

9140

;Power of 10 is stored in B, need to put in A first

9141

xor a

9142

sub b

9143

ld de,pown10LUT

9144

jp p,_59

9145

ld a,b

9146

ld de,pow10LUT

9147

cp 40

9148

jp nc,strToSingle_inf+1

9149

_59:

9150

cp 40

9151

jp nc,strToSingle_zero

9152

ld hl,scrap

9153

ld b,h

9154

ld c,l

9155

call _60

9156

call _60

9157

call _60

9158

call _60

9159

call _60

9160

call _60

9161

pop de

9162

jp mov4

9163

_60:

9164

rra

9165

call c,mulSingle

9166

inc de

9167

inc de

9168

inc de

9169

inc de

9170

ret

9171

str_eng_exp:

9172

ld de,0

9173

inc hl

9174

ld a,(hl)

9175

cp char_NEG ;negative exponent?

9176

push af

9177

jr nz,$+3

9178

inc hl

9179

_61:

9180

ld a,(hl)

9181

sub 3Ah

9182

add a,10

9183

jr nc,_62

9184

inc hl

9185

push hl

9186

ld h,d

9187

ld l,e

9188

add hl,hl

9189

add hl,hl

9190

add hl,de

9191

add hl,hl

9192

add a,l

9193

ld l,a

9194

ex de,hl

9195

pop hl

9196

jp c,eng_overflow

9197

inc d

9198

dec d

9199

jp z,_61

9200

jp nz,eng_overflow

9201

_62:

9202

ld a,e

9203

cp 40

9204

jr nc,eng_overflow

9205

pop af

9206

ld a,b

9207

jr nz,_63

9208

sub e

9209

ld b,a

9210

ret

9211

_63:

9212

add a,e

9213

ld b,a

9214

ret

9215

scrap_times_256:

9216

ld e,8

9217

_64:

9218

or a

9219

ld hl,scrap

9220

call _65

9221

call _65

9222

rl c

9223

dec e

9224

jr nz,_64

9225

ret

9226

_65:

9227

call scrap_times_sub

9228

scrap_times_sub:

9229

ld a,(hl)

9230

rla

9231

cp d

9232

jr c,$+3

9233

sub d

9234

ld (hl),a

9235

inc hl

9236

ccf

9237

ret

9238

eng_overflow:

9239

pop af

9240

jr nz,strToSingle_inf

9241

pop af

9242

strToSingle_zero:

9243

ld hl,const_0

9244

pop de

9245

jp mov4

9246

strToSingle_inf:

9247

;return inf

9248

pop af

9249

ld hl,const_inf

9250

jr nc,_66

9251

ld hl,const_NegInf

9252

_66:

9253

pop de

9254

jp mov4

9255

9256

endif

9257

9258

if defined roundSingle or defined MATH_FRCSGL

9259

9260

;---------------------------------------------------------------------------------------------------------

9261

; int2Single

9262

; http://wikiti.brandonw.net/index.php?title=Z80_Routines:Math:Division#24.2F8_division

9263

;---------------------------------------------------------------------------------------------------------

9264

9265

int2Single:

9266

call pushpop

9267

push bc

9268

push hl

9269

pop ix

9270

ld l, (ix) ; convert integer parameter to single float

9271

ld h, (ix+1)

9272

ld bc, 0x1000 ; bynary digits count + sign

9273

9274

int2Single.test.zero:

9275

xor a

9276

or h ; test if hl is not zero

9277

jr nz, int2Single.test.negative

9278

or l

9279

jr nz, int2Single.test.negative

9280

ld hl, 0

9281

ld de, 0

9282

jp int2Single.save

9283

9284

int2Single.test.negative:

9285

bit 7, h ; test if hl is negative

9286

jr z, int2Single.normalize

9287

ld c, 0x80 ; sign negative

9288

ld a, h ;\

9289

cpl ; |

9290

ld h, a ; | abs(hl)

9291

ld a, l ; |

9292

cpl ; |

9293

ld l, a ;/

9294

inc hl

9295

9296

int2Single.normalize:

9297

dec b

9298

bit 7, h

9299

jr nz, int2Single.mount

9300

sla l

9301

rl h

9302

jr int2Single.normalize

9303

9304

int2Single.mount:

9305

res 7, h ; turn off upper bit

9306

9307

ld a, c ; restore sign

9308

or h ; put sign...

9309

ld h, a ; ...into upper mantissa

9310

9311

ld e, h ; sign+mantissa

9312

ld h, l ; high mantissa

9313

ld l, 0 ; low mantissa

9314

9315

ld a, b ; binary digits count

9316

or 0x80 ; exponent bias

9317

ld d, a ; exponent

9318

9319

int2Single.save:

9320

pop ix

9321

ld (ix), l ; low mantissa

9322

ld (ix+1), h ; high mantissa

9323

ld (ix+2), e ; sign + mantissa

9324

ld (ix+3), d ; expoent

9325

ld (ix+4), 0

9326

ld (ix+5), 0

9327

ld (ix+6), 0

9328

ld (ix+7), 0

9329

ret

9330

9331

endif

9332

9333

if defined roundSingle or defined MATH_FRCINT

9334

9335

;---------------------------------------------------------------------------------------------------------

9336

; single2Int

9337

; http://0x80.pl/articles/convert-float-to-integer.html

9338

;---------------------------------------------------------------------------------------------------------

9339

single2Int:

9340

;Input:

9341

; HL points to the single-precision float

9342

;Output:

9343

; HL is the 16-bit signed integer part of the float

9344

; BC points to 16-bit signed integer

9345

call pushpop

9346

push bc

9347

ld e,(hl)

9348

inc hl

9349

ld d,(hl)

9350

inc hl

9351

ld a,(hl)

9352

add a,a

9353

push af

9354

scf

9355

rra

9356

ld c,a

9357

inc hl

9358

ld a,(hl)

9359

ld hl,0

9360

sub 80h

9361

jr c,no_shift_single_to_int16

9362

cp 39

9363

jr nc,no_shift_single_to_int16

9364

sub 8

9365

jr c,_67

9366

ld l,c

9367

ld c,d

9368

ld d,e

9369

ld e,h

9370

sub 8

9371

jr c,_67

9372

ld h,l

9373

ld l,c

9374

ld c,d

9375

ld d,e

9376

sub 8

9377

jr c,_67

9378

ld h,l

9379

ld l,c

9380

ld c,d

9381

sub 8

9382

jr c,_67

9383

ld h,l

9384

ld l,c

9385

jr _67a ;.db $11 ;start of ld de,*

9386

_67:

9387

add a,9

9388

_67a:

9389

ld b,a

9390

ld a,e

9391

_68:

9392

add a,a

9393

rl d

9394

rl c

9395

adc hl,hl

9396

djnz _68

9397

no_shift_single_to_int16:

9398

pop af

9399

jr nc,_69

9400

;need to negate

9401

xor a

9402

sub e

9403

ld e,0

9404

ld a,e

9405

sbc a,d

9406

ld a,e

9407

sbc a,c

9408

ld d,e

9409

ex de,hl

9410

sbc hl,de

9411

_69:

9412

pop ix

9413

ld (ix), l

9414

ld (ix+1), h

9415

ret

9416

9417

endif

9418

9419

;---------------------------------------------------------------------------------------------------------

9420

; Auxiliary routines

9421

;---------------------------------------------------------------------------------------------------------

9422

9423

str_Zero: db "0",0

9424

str_Inf: db "inf",0

9425

str_NaN: db "NaN",0

9426

9427

start_const:

9428

const_pi: db $DB,$0F,$49,$81

9429

const_e: db $54,$f8,$2d,$81

9430

const_lg_e: db $3b,$AA,$38,$80

9431

const_ln_2: db $18,$72,$31,$7f

9432

const_log2: db $9b,$20,$1a,$7e

9433

const_lg10: db $78,$9a,$54,$81

9434

const_0: db $00,$00,$00,$00

9435

const_1: db $00,$00,$00,$80

9436

const_2: dw 0, 33024

9437

const_3: dw 0, 33088

9438

const_4: dw 0, 33280

9439

const_5: dw 0, 33312

9440

const_7: dw 0, 33376

9441

const_9: dw 0, 33552

9442

const_16: dw 0, 33792

9443

const_100: db $00,$00,$48,$86

9444

const_100_inv: dw 55050, 31011

9445

const_precision: db $77,$CC,$2B,$65 ;10^-8

9446

const_half_1: dw 0, 32512

9447

const_inf: db $00,$00,$40,$00

9448

const_NegInf: db $00,$00,$C0,$00

9449

const_NaN: db $00,$00,$20,$00

9450

const_log10_e: db $D9,$5B,$5E,$7E

9451

const_2pi: db $DB,$0F,$49,$82

9452

const_2pi_inv: db $83,$F9,$22,$7D

9453

const_half_pi: dw 4059, 32841

9454

const_p25: db $00,$00,$00,$7E

9455

const_p5: db $00,$00,$00,$7F

9456

; db $,$,$,$

9457

end_const:

9458

sin_a1: dw 43691, 32042

9459

sin_a2: dw 34952, 30984

9460

sin_a3: dw 3329, 29520

9461

cos_a1: equ const_half_1

9462

cos_a2: dw 43691, 31530

9463

cos_a3: dw 2914, 30262

9464

exp_a1: db $15,$72,$31,$7F ;.693146989552

9465

exp_a2: db $CE,$FE,$75,$7D ;.2402298085906

9466

exp_a3: db $7B,$42,$63,$7B ;.0554833215071

9467

exp_a4: db $FD,$94,$1E,$79 ;.00967907584392

9468

exp_a5: db $5E,$01,$23,$76 ;.001243632065103

9469

exp_a6: db $5F,$B7,$63,$73 ;.0002171671843714

9470

const_1p40625: db $00,$00,$34,$80 ;1.40625

9471

9472

if defined MATH_CONSTSINGLE

9473

9474

iconstSingle:

9475

ex (sp),hl

9476

ld a,(hl)

9477

inc hl

9478

ex (sp),hl

9479

constSingle:

9480

;A is the constant ID#

9481

;returns nc if failed, c otherwise

9482

;HL points to the constant

9483

cp (end_const-start_const)>>2

9484

ret nc

9485

ld hl,start_const

9486

add a,a

9487

add a,a

9488

add a,l

9489

ld l,a

9490

;#if ((end_const-4)>>8)!=(start_const>>8)

9491

; ccf

9492

; ret c

9493

; inc h

9494

;#endif

9495

scf

9496

ret

9497

9498

endif

9499

9500

;;LUTs used

9501

lut:

9502

pown10LUT:

9503

db $CD,$CC,$4C,$7C ;.1

9504

db $0A,$D7,$23,$79 ;.01

9505

db $17,$B7,$51,$72 ;.0001

9506

db $77,$CC,$2B,$65 ;10^-8

9507

db $95,$95,$66,$4A ;10^-16

9508

db $1F,$B1,$4F,$15 ;10^-32

9509

pow10LUT:

9510

const_10:

9511

db $00,$00,$20,$83 ;10

9512

db $00,$00,$48,$86 ;100

9513

db $00,$40,$1C,$8D ;10000

9514

db $20,$BC,$3E,$9A ;10^8

9515

db $CA,$1B,$0E,$B5 ;10^16

9516

db $AE,$C5,$1D,$EA ;10^32

9517

9518

C_Times_BDE:

9519

;;C*BDE => CAHL

9520

;C = 0 157

9521

;C = 1 141

9522

;141+

9523

;C>=128 135+6{0,33+{0,1}}+{0,20+{0,8}}

9524

;C>=64 115+5{0,33+{0,1}}+{0,20+{0,8}}

9525

;C>=32 95+4{0,33+{0,1}}+{0,20+{0,8}}

9526

;C>=16 75+3{0,33+{0,1}}+{0,20+{0,8}}

9527

;C>=8 55+2{0,33+{0,1}}+{0,20+{0,8}}

9528

;C>=4 35+{0,33+{0,1}}+{0,20+{0,8}}

9529

;C>=2 15+{0,20+{0,8}}

9530

;min: 141cc

9531

;max: 508cc

9532

;avg: 349.21279907227cc

9533

9534

ld a,b

9535

ld h,d

9536

ld l,e

9537

sla c

9538

jr c,mul8_24_1

9539

sla c

9540

jr c,mul8_24_2

9541

sla c

9542

jr c,mul8_24_3

9543

sla c

9544

jr c,mul8_24_4

9545

sla c

9546

jr c,mul8_24_5

9547

sla c

9548

jr c,mul8_24_6

9549

sla c

9550

jr c,mul8_24_7

9551

sla c

9552

ret c

9553

ld a,c

9554

ld h,c

9555

ld l,c

9556

ret

9557

mul8_24_1:

9558

add hl,hl

9559

rla

9560

rl c

9561

jr nc,$+7

9562

add hl,de

9563

adc a,b

9564

jr nc,$+3

9565

inc c

9566

mul8_24_2:

9567

add hl,hl

9568

rla

9569

rl c

9570

jr nc,$+7

9571

add hl,de

9572

adc a,b

9573

jr nc,$+3

9574

inc c

9575

mul8_24_3:

9576

add hl,hl

9577

rla

9578

rl c

9579

jr nc,$+7

9580

add hl,de

9581

adc a,b

9582

jr nc,$+3

9583

inc c

9584

mul8_24_4:

9585

add hl,hl

9586

rla

9587

rl c

9588

jr nc,$+7

9589

add hl,de

9590

adc a,b

9591

jr nc,$+3

9592

inc c

9593

mul8_24_5:

9594

add hl,hl

9595

rla

9596

rl c

9597

jr nc,$+7

9598

add hl,de

9599

adc a,b

9600

jr nc,$+3

9601

inc c

9602

mul8_24_6:

9603

add hl,hl

9604

rla

9605

rl c

9606

jr nc,$+7

9607

add hl,de

9608

adc a,b

9609

jr nc,$+3

9610

inc c

9611

mul8_24_7:

9612

add hl,hl

9613

rla

9614

rl c

9615

ret nc

9616

add hl,de

9617

adc a,b

9618

ret nc

9619

inc c

9620

ret

9621

9622

pushpop:

9623

;26 bytes, adds 118cc to the traditional routine

9624

ex (sp),hl

9625

push de

9626

push bc

9627

push af

9628

push hl

9629

ld hl,pushpopret

9630

ex (sp),hl

9631

push hl

9632

push af

9633

ld hl,12

9634

add hl,sp

9635

ld a,(hl)

9636

inc hl

9637

ld h,(hl)

9638

ld l,a

9639

pop af

9640

ret

9641

pushpopret:

9642

pop af

9643

pop bc

9644

pop de

9645

pop hl

9646

ret

9647

9648

mov4:

9649

ldi

9650

ldi

9651

ldi

9652

ldi

9653

ret

9654

9655

if defined MATH_FIN

9656

9657

ascii_to_uint8:

9658

;c flag means don't increment the exponent

9659

ld c,0

9660

ld a,(hl)

9661

jr c,ascii_to_uint8_noexp

9662

cp char_DEC

9663

jr z,ascii_to_uint8_noexp-2

9664

_70:

9665

sub 3Ah

9666

add a,10

9667

jr nc,ascii_to_uint8_noexp_end

9668

inc b

9669

ld c,a

9670

add a,a

9671

add a,a

9672

add a,c

9673

add a,a

9674

ld c,a

9675

inc hl

9676

_71:

9677

ld a,(hl)

9678

cp char_DEC

9679

jr z,ascii_to_uint8_noexp_2nd

9680

_72:

9681

sub 3Ah

9682

add a,10

9683

jr nc,ascii_to_uint8_noexp_end

9684

inc b

9685

add a,c

9686

inc hl

9687

ld (de),a

9688

dec de

9689

or a

9690

ret

9691

9692

inc hl

9693

ld a,(hl)

9694

ascii_to_uint8_noexp:

9695

sub 3Ah

9696

add a,10

9697

jr nc,ascii_to_uint8_noexp_end

9698

ld c,a

9699

add a,a

9700

add a,a

9701

add a,c

9702

add a,a

9703

ld c,a

9704

ascii_to_uint8_noexp_2nd:

9705

inc hl

9706

ld a,(hl)

9707

sub 3Ah

9708

add a,10

9709

jr nc,ascii_to_uint8_noexp_end

9710

add a,c

9711

inc hl

9712

jr ascii_2 ;.db $FE ;start of `cp **`, saves 1cc

9713

ascii_to_uint8_noexp_end:

9714

ld a,c

9715

ascii_2:

9716

ld (de),a

9717

dec de

9718

scf

9719

ret

9720

9721

endif

9722

9723

if defined MATH_RSUBSINGLE

9724

9725

rsubSingle:

9726

;;-x+y

9727

push af

9728

push hl

9729

push de

9730

push bc

9731

push de

9732

ld de,addend2

9733

ldi

9734

ldi

9735

ld a,(hl)

9736

xor 80h

9737

ld (de),a

9738

inc de

9739

inc hl

9740

ld a,(hl)

9741

ld (de),a

9742

pop de

9743

ld hl,addend2

9744

jp addInject ;jumps in to the addSingle routine

9745

9746

endif

9747

9748

if defined MATH_MOD1SINGLE

9749

9750

;This routine performs `x mod 1`, returning a non-negative value.

9751

;+inf -> NaN

9752

;-inf -> NaN

9753

;NaN -> NaN

9754

mod1Single:

9755

call pushpop

9756

push bc

9757

ld e,(hl)

9758

inc hl

9759

ld d,(hl)

9760

inc hl

9761

ld c,(hl)

9762

ld a,c

9763

xor 80h

9764

push af

9765

jp p,mod1Single.1

9766

ld c,a

9767

mod1Single.1:

9768

9769

inc hl

9770

ld a,(hl)

9771

ld b,a

9772

or a

9773

jr z,mod1Single_special

9774

sub $80

9775

jr c,mod1_end

9776

inc a

9777

ld b,a

9778

ld a,c

9779

ex de,hl

9780

mod1Single.2:

9781

add hl,hl

9782

rla

9783

djnz mod1Single.2

9784

ld c,a

9785

9786

;If it is zero, need to set exponent to zero and return

9787

or h

9788

or l

9789

ex de,hl

9790

jr z,mod1_end

9791

9792

;Need to normalize

9793

ld b,$7F

9794

ld a,c

9795

or a

9796

jp m,mod1_end

9797

ex de,hl

9798

mod1Single.3:

9799

dec b

9800

add hl,hl

9801

adc a,a

9802

jp p,mod1Single.3

9803

ld c,a

9804

ex de,hl

9805

mod1_end:

9806

pop af

9807

pop hl

9808

jp m,mod1Single.4

9809

;make sure it isn't zero else we need to add 1

9810

ld a,b

9811

or a

9812

jr z,mod1Single.4

9813

ld (scrap),de

9814

ld (scrap+2),bc

9815

ld b,h

9816

ld c,l

9817

ld hl,scrap

9818

ld de,const_1

9819

jp addSingle

9820

mod1Single_special:

9821

;If INF, need to return NaN instead

9822

;For 0 and NaN, just return itself :)

9823

pop af

9824

pop hl

9825

ld a,c

9826

add a,a

9827

jp p,mod1Single.4

9828

ld c,$40

9829

mod1Single.4:

9830

res 7,c

9831

ld (hl),e

9832

inc hl

9833

ld (hl),d

9834

inc hl

9835

ld (hl),c

9836

inc hl

9837

ld (hl),b

9838

ret

9839

9840

endif

9841

9842

if defined MATH_FOUT

9843

9844

; --------------------------------------------------------------

9845

; Converts a signed integer value to a zero-terminated ASCII

9846

; string representative of that value (using radix 10).

9847

; References:

9848

; Brandon Wilson WikiTI

9849

; http://wikiti.brandonw.net/index.php?title=Z80_Routines:Other:DispA#Decimal_Signed_Version

9850

; --------------------------------------------------------------

9851

; INPUTS:

9852

; HL Value to convert (two's complement integer).

9853

; DE Base address of string destination. (pointer).

9854

; --------------------------------------------------------------

9855

; OUTPUTS:

9856

; A Size of string

9857

; --------------------------------------------------------------

9858

; REGISTERS/MEMORY DESTROYED

9859

; AF HL

9860

; --------------------------------------------------------------

9861

9862

IntToStr:

9863

push de

9864

push bc

9865

9866

; Detect sign of HL.

9867

bit 7, h

9868

jr z, _DoConvert

9869

9870

; HL is negative. Output '-' to string and negate HL.

9871

ld a, '-'

9872

ld (de), a

9873

inc de

9874

9875

; Negate HL (using two's complement)

9876

xor a

9877

sub l

9878

ld l, a

9879

ld a, 0 ; Note that XOR A or SUB A would disturb CF

9880

sbc a, h

9881

ld h, a

9882

9883

; Convert HL to digit characters

9884

_DoConvert:

9885

ld b, 0 ; B will count character length of number

9886

_DoConvert.1:

9887

ld c, 10

9888

call div_hl_c; HL = HL / A, A = remainder

9889

push af

9890

inc b

9891

ld a, h

9892

or l

9893

jr nz, _DoConvert.1

9894

9895

; Retrieve digits from stack

9896

_DoConvert.2:

9897

pop af

9898

or $30

9899

ld (de), a

9900

inc de

9901

djnz _DoConvert.2

9902

9903

; Terminate string with NULL

9904

xor a

9905

ld (de), a

9906

9907

ld h, d

9908

ld l, e

9909

9910

pop bc

9911

pop de

9912

9913

sbc hl, de

9914

ld a, l ; string size

9915

9916

ret

9917

9918

endif

9919

9920

if defined MATH_FIN

9921

9922

;===============================================================

9923

; Convert a string of base-10 digits to a 16-bit value.

9924

; http://z80-heaven.wikidot.com/math#toc32

9925

;Input:

9926

; DE points to the base 10 number string in RAM.

9927

;Outputs:

9928

; HL is the 16-bit value of the number

9929

; DE points to the byte after the number

9930

; BC is HL/10

9931

; z flag reset (nz)

9932

; c flag reset (nc)

9933

;Destroys:

9934

; A (actually, add 30h and you get the ending token)

9935

;Size: 23 bytes

9936

;Speed: 104n+42+11c

9937

; n is the number of digits

9938

; c is at most n-2

9939

; at most 595 cycles for any 16-bit decimal value

9940

;===============================================================

9941

9942

StrToInt:

9943

ld hl,0 ; 10 : 210000

9944

ConvLoop: ;

9945

ld a,(de) ; 7 : 1A

9946

sub 30h ; 7 : D630

9947

cp 10 ; 7 : FE0A

9948

ret nc ;5|11 : D0

9949

inc de ; 6 : 13

9950

;

9951

ld b,h ; 4 : 44

9952

ld c,l ; 4 : 4D

9953

add hl,hl ; 11 : 29

9954

add hl,hl ; 11 : 29

9955

add hl,bc ; 11 : 09

9956

add hl,hl ; 11 : 29

9957

;

9958

add a,l ; 4 : 85

9959

ld l,a ; 4 : 6F

9960

jr nc,ConvLoop ;12|23: 30EE

9961

inc h ; --- : 24

9962

jr ConvLoop ; --- : 18EB

9963

9964

endif

9965

9966

if defined IntToStr

9967

9968

; divides hl by c

9969

; return remainder in a

9970

; http://wikiti.brandonw.net/index.php?title=Z80_Routines:Math:Division

9971

div_hl_c:

9972

push bc

9973

xor a

9974

ld b, 16

9975

div_hl_c.loop:

9976

add hl, hl

9977

rla

9978

jr c, $+5

9979

cp c

9980

jr c, $+4

9981

sub c

9982

inc l

9983

djnz div_hl_c.loop

9984

pop bc

9985

ret

9986

9987

endif

9988

9989

if defined DIV_EHL

9990

9991

; http://wikiti.brandonw.net/index.php?title=Z80_Routines:Math:Division#24.2F8_division

9992

div_ehl_d:

9993

xor a

9994

ld b, 24

9995

div_ehl_d.loop:

9996

add hl, hl

9997

rl e

9998

rla

9999

jr c, $+5

10000

cp d

10001

jr c, $+4

10002

sub d

10003

inc l

10004

djnz div_ehl_d.loop

10005

ret

10006

10007

div_dehl_c:

10008

push bc

10009

xor a

10010

ld b, 32

10011

div_dehl_c.loop:

10012

add hl, hl

10013

rl e

10014

rl d

10015

rla

10016

jr c, $+5

10017

cp c

10018

jr c, $+4

10019

sub c

10020

inc l

10021

djnz div_dehl_c.loop

10022

pop bc

10023

ret

10024

10025

endif

10026

10027

10028

romSize: equ 0x8000 ; ROM size (32k)

10029

10030

workAreaSize: equ 0x500

10031

workAreaPad: ds romSize - workAreaPad - workAreaSize, 0

10032

10033

10034

;---------------------------------------------------------------------------------------------------------

10035

; MAIN WORK AREA - LITERALS / VARIABLES / CONFIGURATIONS

10036

;---------------------------------------------------------------------------------------------------------

10037

10038

VAR_STACK.START: equ ramArea

10039

;VAR_STACK.END: equ VAR_STACK.START + 0x800 ; 2kb (~200 variables)

10040

10041

VAR_STACK.POINTER: equ VAR_STACK.START

10042

10043

PRINT.CRLF: db 3, 0, 0, 2

10044

dw PRINT.CRLF.DATA, 0, 0, 0

10045

PRINT.CRLF.DATA: db 13,10,0

10046

10047

PRINT.TAB: db 3, 0, 0, 1

10048

dw PRINT.TAB.DATA, 0, 0, 0

10049

PRINT.TAB.DATA: db 09,0

10050

10051

; null double

10052

LIT_NULL_DBL: dw 0, 0, 0, 0

10053

10054

; null string

10055

LIT_NULL_STR: db 0

10056

10057

; quote string

10058

LIT_QUOTE_CHAR: db '\"'

10059

10060

; logical true

10061

LIT_TRUE: db 2, 0, 0

10062

dw 0, 0xFFFF, 0, 0

10063

10064

; logical false

10065

LIT_FALSE: db 2, 0, 0

10066

dw 0, 0, 0, 0

10067

10068

10069

10070

; numerical literal

10071

LIT_6: db 2, 0, 0

10072

dw 0, 1, 0, 0

10073

10074

; numerical literal

10075

LIT_9: db 2, 0, 0

10076

dw 0, 15, 0, 0

10077

10078

; numerical literal

10079

LIT_11: db 2, 0, 0

10080

dw 0, 2, 0, 0

10081

10082

; numerical literal

10083

LIT_13: db 2, 0, 0

10084

dw 0, 1, 0, 0

10085

10086

; identifier P

10087

IDF_14: equ VAR_STACK.POINTER + 0

10088

10089

; numerical literal

10090

LIT_15: db 2, 0, 0

10091

dw 0, 0, 0, 0

10092

10093

; identifier E

10094

IDF_16: equ VAR_STACK.POINTER + 11

10095

10096

; numerical literal

10097

LIT_17: db 2, 0, 0

10098

dw 0, 10, 0, 0

10099

10100

; identifier X

10101

IDF_18: equ VAR_STACK.POINTER + 22

10102

10103

; numerical literal

10104

LIT_19: db 2, 0, 0

10105

dw 0, 150, 0, 0

10106

10107

; identifier Y

10108

IDF_20: equ VAR_STACK.POINTER + 33

10109

10110

; numerical literal

10111

LIT_21: db 2, 0, 0

10112

dw 0, 150, 0, 0

10113

10114

; identifier MY

10115

IDF_22: equ VAR_STACK.POINTER + 44

10116

10117

; numerical literal

10118

LIT_23: db 2, 0, 0

10119

dw 0, 1, 0, 0

10120

10121

; identifier F

10122

IDF_24: equ VAR_STACK.POINTER + 55

10123

10124

; numerical literal

10125

LIT_25: db 2, 0, 0

10126

dw 0, 6, 0, 0

10127

10128

; identifier A$

10129

IDF_26: equ VAR_STACK.POINTER + 66

10130

10131

; string literal

10132

LIT_27: db 3, 0, 0, 17

10133

dw LIT_27_DATA, 0, 0

10134

db 0

10135

LIT_27_DATA: db "O4L8EBGBEAO5C#O4A", 0

10136

10137

; numerical literal

10138

LIT_30: db 2, 0, 0

10139

dw 0, 10, 0, 0

10140

10141

; numerical literal

10142

LIT_31: db 2, 0, 0

10143

dw 0, 10, 0, 0

10144

10145

; string literal

10146

LIT_33: db 3, 0, 0, 12

10147

dw LIT_33_DATA, 0, 0

10148

db 0

10149

LIT_33_DATA: db "CATA-METEORO", 0

10150

10151

; numerical literal

10152

LIT_34: db 2, 0, 0

10153

dw 0, 10, 0, 0

10154

10155

; numerical literal

10156

LIT_35: db 2, 0, 0

10157

dw 0, 11, 0, 0

10158

10159

; string literal

10160

LIT_36: db 3, 0, 0, 12

10161

dw LIT_36_DATA, 0, 0

10162

db 0

10163

LIT_36_DATA: db "************", 0

10164

10165

; numerical literal

10166

LIT_37: db 2, 0, 0

10167

dw 0, 8, 0, 0

10168

10169

; numerical literal

10170

LIT_38: db 2, 0, 0

10171

dw 0, 120, 0, 0

10172

10173

; string literal

10174

LIT_39: db 3, 0, 0, 16

10175

dw LIT_39_DATA, 0, 0

10176

db 0

10177

LIT_39_DATA: db "CLUBE MSX - 2019", 0

10178

10179

; identifier C%

10180

IDF_42: equ VAR_STACK.POINTER + 77

10181

10182

; numerical literal

10183

LIT_45: db 2, 0, 0

10184

dw 0, 0, 0, 0

10185

10186

; numerical literal

10187

LIT_46: db 2, 0, 0

10188

dw 0, 1, 0, 0

10189

10190

; numerical literal

10191

LIT_51: db 2, 0, 0

10192

dw 0, 90, 0, 0

10193

10194

; numerical literal

10195

LIT_53: db 2, 0, 0

10196

dw 0, 1, 0, 0

10197

10198

; numerical literal

10199

LIT_54: db 2, 0, 0

10200

dw 0, 70, 0, 0

10201

10202

; numerical literal

10203

LIT_56: db 2, 0, 0

10204

dw 0, 65, 0, 0

10205

10206

; numerical literal

10207

LIT_58: db 2, 0, 0

10208

dw 0, 5, 0, 0

10209

10210

; numerical literal

10211

LIT_60: db 2, 0, 0

10212

dw 0, 1, 0, 0

10213

10214

; numerical literal

10215

LIT_63: db 2, 0, 0

10216

dw 0, 300, 0, 0

10217

10218

; numerical literal

10219

LIT_65: db 2, 0, 0

10220

dw 0, TAG_180, 0, 0

10221

10222

; numerical literal

10223

LIT_67: db 2, 0, 0

10224

dw 0, 3, 0, 0

10225

10226

; numerical literal

10227

LIT_68: db 2, 0, 0

10228

dw 0, TAG_230, 0, 0

10229

10230

; identifier I

10231

IDF_71: equ VAR_STACK.POINTER + 88

10232

10233

; numerical literal

10234

LIT_72: db 2, 0, 0

10235

dw 0, 0, 0, 0

10236

10237

; numerical literal

10238

LIT_75: db 2, 0, 0

10239

dw 0, 1, 0, 0

10240

10241

; numerical literal

10242

LIT_78: db 2, 0, 0

10243

dw 0, 30, 0, 0

10244

10245

; numerical literal

10246

LIT_81: db 2, 0, 0

10247

dw 0, 1, 0, 0

10248

10249

; numerical literal

10250

LIT_82: db 2, 0, 0

10251

dw 0, 15, 0, 0

10252

10253

; numerical literal

10254

LIT_86: db 2, 0, 0

10255

dw 0, 1, 0, 0

10256

10257

; numerical literal

10258

LIT_87: db 2, 0, 0

10259

dw 0, 250, 0, 0

10260

10261

; numerical literal

10262

LIT_88: db 2, 0, 0

10263

dw 0, 1, 0, 0

10264

10265

; numerical literal

10266

LIT_89: db 2, 0, 0

10267

dw 0, 150, 0, 0

10268

10269

; numerical literal

10270

LIT_92: db 2, 0, 0

10271

dw 0, 190, 0, 0

10272

10273

; numerical literal

10274

LIT_93: db 2, 0, 0

10275

dw 0, 15, 0, 0

10276

10277

; numerical literal

10278

LIT_94: db 2, 0, 0

10279

dw 0, 2, 0, 0

10280

10281

; numerical literal

10282

LIT_95: db 2, 0, 0

10283

dw 0, 1, 0, 0

10284

10285

; numerical literal

10286

LIT_99: db 2, 0, 0

10287

dw 0, 0, 0, 0

10288

10289

; numerical literal

10290

LIT_100: db 2, 0, 0

10291

dw 0, 1, 0, 0

10292

10293

; numerical literal

10294

LIT_101: db 2, 0, 0

10295

dw 0, 3, 0, 0

10296

10297

; numerical literal

10298

LIT_103: db 2, 0, 0

10299

dw 0, 238, 0, 0

10300

10301

; numerical literal

10302

LIT_106: db 2, 0, 0

10303

dw 0, 4, 0, 0

10304

10305

; numerical literal

10306

LIT_107: db 2, 0, 0

10307

dw 0, 7, 0, 0

10308

10309

; numerical literal

10310

LIT_108: db 2, 0, 0

10311

dw 0, 4, 0, 0

10312

10313

; numerical literal

10314

LIT_110: db 2, 0, 0

10315

dw 0, 4, 0, 0

10316

10317

; numerical literal

10318

LIT_113: db 2, 0, 0

10319

dw 0, 1, 0, 0

10320

10321

; numerical literal

10322

LIT_114: db 2, 0, 0

10323

dw 0, 15, 0, 0

10324

10325

; numerical literal

10326

LIT_115: db 2, 0, 0

10327

dw 0, 0, 0, 0

10328

10329

; numerical literal

10330

LIT_116: db 2, 0, 0

10331

dw 0, 210, 0, 0

10332

10333

; numerical literal

10334

LIT_117: db 2, 0, 0

10335

dw 0, 0, 0, 0

10336

10337

; identifier MX

10338

IDF_118: equ VAR_STACK.POINTER + 99

10339

10340

; numerical literal

10341

LIT_119: db 2, 0, 0

10342

dw 0, 8, 0, 0

10343

10344

; numerical literal

10345

LIT_120: db 2, 0, 0

10346

dw 0, 0, 0, 0

10347

10348

; numerical literal

10349

LIT_121: db 2, 0, 0

10350

dw 0, 1, 0, 0

10351

10352

; numerical literal

10353

LIT_122: db 2, 0, 0

10354

dw 0, 50, 0, 0

10355

10356

; numerical literal

10357

LIT_123: db 2, 0, 0

10358

dw 0, 100, 0, 0

10359

10360

; numerical literal

10361

LIT_124: db 2, 0, 0

10362

dw 0, 0, 0, 0

10363

10364

; numerical literal

10365

LIT_125: db 2, 0, 0

10366

dw 0, 0, 0, 0

10367

10368

; numerical literal

10369

LIT_126: db 2, 0, 0

10370

dw 0, 0, 0, 0

10371

10372

; numerical literal

10373

LIT_127: db 2, 0, 0

10374

dw 0, 10, 0, 0

10375

10376

; string literal

10377

LIT_128: db 3, 0, 0, 5

10378

dw LIT_128_DATA, 0, 0

10379

db 0

10380

LIT_128_DATA: db "L8DC-", 0

10381

10382

; numerical literal

10383

LIT_129: db 2, 0, 0

10384

dw 0, 10, 0, 0

10385

10386

; numerical literal

10387

LIT_130: db 2, 0, 0

10388

dw 0, 1, 0, 0

10389

10390

; numerical literal

10391

LIT_131: db 2, 0, 0

10392

dw 0, 190, 0, 0

10393

10394

; numerical literal

10395

LIT_133: db 2, 0, 0

10396

dw 0, 0, 0, 0

10397

10398

; numerical literal

10399

LIT_134: db 2, 0, 0

10400

dw 0, 3, 0, 0

10401

10402

; string literal

10403

LIT_135: db 3, 0, 0, 5

10404

dw LIT_135_DATA, 0, 0

10405

db 0

10406

LIT_135_DATA: db "L8C+C", 0

10407

10408

; numerical literal

10409

LIT_136: db 2, 0, 0

10410

dw 0, 1, 0, 0

10411

10412

; numerical literal

10413

LIT_137: db 2, 0, 0

10414

dw 0, 0, 0, 0

10415

10416

; numerical literal

10417

LIT_138: db 2, 0, 0

10418

dw 0, 20, 0, 0

10419

10420

; numerical literal

10421

LIT_140: db 2, 0, 0

10422

dw 0, 0, 0, 0

10423

10424

; numerical literal

10425

LIT_141: db 2, 0, 0

10426

dw 0, 1, 0, 0

10427

10428

; numerical literal

10429

LIT_142: db 2, 0, 0

10430

dw 0, 1, 0, 0

10431

10432

; numerical literal

10433

LIT_143: db 2, 0, 0

10434

dw 0, 250, 0, 0

10435

10436

; numerical literal

10437

LIT_144: db 2, 0, 0

10438

dw 0, 2, 0, 0

10439

10440

; numerical literal

10441

LIT_145: db 2, 0, 0

10442

dw 0, 2, 0, 0

10443

10444

; numerical literal

10445

LIT_147: db 2, 0, 0

10446

dw 0, 1, 0, 0

10447

10448

; numerical literal

10449

LIT_148: db 2, 0, 0

10450

dw 0, 8, 0, 0

10451

10452

; numerical literal

10453

LIT_149: db 2, 0, 0

10454

dw 0, 6, 0, 0

10455

10456

; numerical literal

10457

LIT_151: db 2, 0, 0

10458

dw 0, 1, 0, 0

10459

10460

; numerical literal

10461

LIT_152: db 2, 0, 0

10462

dw 0, 180, 0, 0

10463

10464

; numerical literal

10465

LIT_153: db 2, 0, 0

10466

dw 0, 200, 0, 0

10467

10468

; numerical literal

10469

LIT_154: db 2, 0, 0

10470

dw 0, 200, 0, 0

10471

10472

; numerical literal

10473

LIT_155: db 2, 0, 0

10474

dw 0, 2, 0, 0

10475

10476

; numerical literal

10477

LIT_156: db 2, 0, 0

10478

dw 0, 15, 0, 0

10479

10480

; numerical literal

10481

LIT_157: db 2, 0, 0

10482

dw 0, 2, 0, 0

10483

10484

; numerical literal

10485

LIT_158: db 2, 0, 0

10486

dw 0, 180, 0, 0

10487

10488

; string literal

10489

LIT_159: db 3, 0, 0, 7

10490

dw LIT_159_DATA, 0, 0

10491

db 0

10492

LIT_159_DATA: db "PLACAR:", 0

10493

10494

; string literal

10495

LIT_160: db 3, 0, 0, 14

10496

dw LIT_160_DATA, 0, 0

10497

db 0

10498

LIT_160_DATA: db " ENERGIA:", 0

10499

10500

; numerical literal

10501

LIT_161: db 2, 0, 0

10502

dw 0, 1, 0, 0

10503

10504

; numerical literal

10505

LIT_162: db 2, 0, 0

10506

dw 0, 10, 0, 0

10507

10508

; numerical literal

10509

LIT_163: db 2, 0, 0

10510

dw 0, 10, 0, 0

10511

10512

; string literal

10513

LIT_164: db 3, 0, 0, 12

10514

dw LIT_164_DATA, 0, 0

10515

db 0

10516

LIT_164_DATA: db "FIM DE JOGO!", 0

10517

10518

; string literal

10519

LIT_165: db 3, 0, 0, 56

10520

dw LIT_165_DATA, 0, 0

10521

db 0

10522

LIT_165_DATA: db "A3R15A4R15A8R15A3R15O5C5O4R15B8R15B5R15A8R15A5R15A8R15A1", 0

10523

10524

; numerical literal

10525

LIT_166: db 2, 0, 0

10526

dw 0, 1, 0, 0

10527

10528

; numerical literal

10529

LIT_167: db 2, 0, 0

10530

dw 0, 220, 0, 0

10531

10532

; numerical literal

10533

LIT_168: db 2, 0, 0

10534

dw 0, 50, 0, 0

10535

10536

; numerical literal

10537

LIT_169: db 2, 0, 0

10538

dw 0, 150, 0, 0

10539

10540

; numerical literal

10541

LIT_170: db 2, 0, 0

10542

dw 0, 185, 0, 0

10543

10544

; identifier M$

10545

IDF_171: equ VAR_STACK.POINTER + 110

10546

10547

; string literal

10548

LIT_172: db 3, 0, 0, 0

10549

dw LIT_172_DATA, 0, 0

10550

db 0

10551

LIT_172_DATA: db "", 0

10552

10553

; numerical literal

10554

LIT_173: db 2, 0, 0

10555

dw 0, 1, 0, 0

10556

10557

; numerical literal

10558

LIT_174: db 2, 0, 0

10559

dw 0, 1, 0, 0

10560

10561

; numerical literal

10562

LIT_175: db 2, 0, 0

10563

dw 0, 8, 0, 0

10564

10565

; identifier S

10566

IDF_177: equ VAR_STACK.POINTER + 121

10567

10568

; identifier CM$

10569

IDF_179: equ VAR_STACK.POINTER + 132

10570

10571

; string literal

10572

LIT_180: db 3, 0, 0, 0

10573

dw LIT_180_DATA, 0, 0

10574

db 0

10575

LIT_180_DATA: db "", 0

10576

10577

; numerical literal

10578

LIT_181: db 2, 0, 0

10579

dw 0, 1, 0, 0

10580

10581

; numerical literal

10582

LIT_182: db 2, 0, 0

10583

dw 0, 1, 0, 0

10584

10585

; numerical literal

10586

LIT_183: db 2, 0, 0

10587

dw 0, 8, 0, 0

10588

10589

; numerical literal

10590

LIT_185: db 2, 0, 0

10591

dw 0, 0, 0, 0

10592

10593

; numerical literal

10594

LIT_186: db 2, 0, 0

10595

dw 0, 1, 0, 0

10596

10597

; numerical literal

10598

LIT_188: db 2, 0, 0

10599

dw 0, &x00011000, 0, 0

10600

10601

; numerical literal

10602

LIT_189: db 2, 0, 0

10603

dw 0, &x00100100, 0, 0

10604

10605

; numerical literal

10606

LIT_190: db 2, 0, 0

10607

dw 0, &x01110110, 0, 0

10608

10609

; numerical literal

10610

LIT_191: db 2, 0, 0

10611

dw 0, &x11011111, 0, 0

10612

10613

; numerical literal

10614

LIT_192: db 2, 0, 0

10615

dw 0, &x11001111, 0, 0

10616

10617

; numerical literal

10618

LIT_193: db 2, 0, 0

10619

dw 0, &x01100110, 0, 0

10620

10621

; numerical literal

10622

LIT_194: db 2, 0, 0

10623

dw 0, &x00110100, 0, 0

10624

10625

; numerical literal

10626

LIT_195: db 2, 0, 0

10627

dw 0, &x00011000, 0, 0

10628

10629

; numerical literal

10630

LIT_196: db 2, 0, 0

10631

dw 0, &x10000001, 0, 0

10632

10633

; numerical literal

10634

LIT_197: db 2, 0, 0

10635

dw 0, &x10000001, 0, 0

10636

10637

; numerical literal

10638

LIT_198: db 2, 0, 0

10639

dw 0, &x10000001, 0, 0

10640

10641

; numerical literal

10642

LIT_199: db 2, 0, 0

10643

dw 0, &x11000011, 0, 0

10644

10645

; numerical literal

10646

LIT_200: db 2, 0, 0

10647

dw 0, &x11000011, 0, 0

10648

10649

; numerical literal

10650

LIT_201: db 2, 0, 0

10651

dw 0, &x11111111, 0, 0

10652

10653

; numerical literal

10654

LIT_202: db 2, 0, 0

10655

dw 0, &x11111111, 0, 0

10656

10657

; numerical literal

10658

LIT_203: db 2, 0, 0

10659

dw 0, &x11000011, 0, 0

10660

10661

AFTER_LAST_VARIABLE: equ VAR_STACK.POINTER + 143

10662

10663

VAR_DUMMY.START: equ AFTER_LAST_VARIABLE ; variable dummy circular queue area

10664

VAR_DUMMY.COUNTER: equ VAR_DUMMY.START ; variable dummy circular queue count

10665

VAR_DUMMY.POINTER: equ VAR_DUMMY.COUNTER + 1 ; pointer to next variable dummy

10666

VAR_DUMMY.DATA: equ VAR_DUMMY.POINTER + 2 ; first variable dummy

10667

10668

VAR_DUMMY.SIZE: equ 8

10669

VAR_DUMMY.LENGTH: equ (11 * VAR_DUMMY.SIZE)

10670

VAR_DUMMY.END: equ VAR_DUMMY.DATA + VAR_DUMMY.LENGTH

10671

VAR_STACK.END: equ VAR_DUMMY.END + 1

10672

10673

10674

;--------------------------------------------------------

10675

; DATA SIMBOLS

10676

;--------------------------------------------------------

10677

10678

DATA_ITEMS:

10679

dw LIT_188

10680

dw LIT_189

10681

dw LIT_190

10682

dw LIT_191

10683

dw LIT_192

10684

dw LIT_193

10685

dw LIT_194

10686

dw LIT_195

10687

dw LIT_196

10688

dw LIT_197

10689

dw LIT_198

10690

dw LIT_199

10691

dw LIT_200

10692

dw LIT_201

10693

dw LIT_202

10694

dw LIT_203

10695

DATA_ITEMS_COUNT: equ 16

10696

10697

10698

START_PLAY:

10699

ld HL, 0x752E

10700

ld (BIOS_MCLTAB),HL

10701

ld a, 1

10702

ld (BIOS_MCLFLG),A

10703

ld hl, BIOS_TEMP ; voice count

10704

ld a, 3

10705

sub (hl)

10706

dec a

10707

ld (BIOS_PRSCNT), a

10708

xor a

10709

ld (BIOS_VOICEN), a

10710

ld (BIOS_QUEUEN), a

10711

ld (BIOS_MUSICF), a

10712

ld HL,0 ;-12 ; -10

10713

add HL,SP

10714

ld (BIOS_SAVSP),HL

10715

ld HL, BIOS_PLYCNT

10716

ld (HL), 0

10717

;__call_basic BASIC_PLAY_DIRECT

10718

ret

10719

10720

; ix = address to call

10721

CALL_BIOS:

10722

ld iy, CALL_BIOS.return

10723

push iy

10724

push ix

10725

call BASIC_SLOT_ENABLE

10726

ret

10727

CALL_BIOS.return:

10728

call PROGRAM_SLOT_1_ENABLE_2

10729

ret

10730

10731

10732

10733

BIOS_SLOT_ENABLE:

10734

ld a, (BIOS_EXPTBL)

10735

ld hl,0

10736

call BIOS_ENASLT ; Select main ROM on page 0 (0000h~3FFFh)

10737

ret

10738

10739

BASIC_SLOT_ENABLE:

10740

ld a, (BIOS_EXPTBL)

10741

ld hl,04000h

10742

call BIOS_ENASLT ; Select main ROM on page 1 (4000h~7FFFh)

10743

ret

10744

10745

PROGRAM_SLOT_1_ENABLE_2:

10746

call BIOS_RSLREG

10747

rrca

10748

rrca

10749

call PROGRAM_SLOT_ENABLE_SUB_2

10750

ld h,040h

10751

jp BIOS_ENASLT ; Select the ROM on page 4000h-7FFFh

10752

10753

PROGRAM_SLOT_ENABLE_SUB_2:

10754

rrca

10755

rrca

10756

and 3 ;Keep bits corresponding to the page

10757

ld c,a

10758

ld b,0

10759

ld hl,BIOS_EXPTBL

10760

add hl,bc

10761

ld a,(hl)

10762

and 80h

10763

or c

10764

ld c,a

10765

inc hl

10766

inc hl

10767

inc hl

10768

inc hl

10769

ld a,(hl)

10770

and 0Ch

10771

or c

10772

ret

10773

10774

;---------------------------------------------------------------------------------------------------------

10775

; PROGRAM FOOTER

10776

;---------------------------------------------------------------------------------------------------------

10777

10778

if defined COMPILE_TO_ROM

10779

10780

romPad: ds romSize - (romPad - pgmArea), 0

10781

10782

endif

10783

10784

end_file: end start_pgm ; label start is the entry point

10785

10786

Older »