{$a-} {*********************************************************} {* Some procedures for the MSX 2, MSX 2+ and MSX turbo R *} {* Copyright 1987..1994 by XelaSoft *} {* Released for public domain *} {* release date version changes *} {* 6-17-1994 1.0 *} {* 6-29-1994 1.1 MSX 2+ screens added *} {* Excuse me for the bad programming style, but I have *} {* worked on this library on very different times. *} {* *} {* For information, please contact me through *} {* http://www.msx-plaza.eu/home.php?appl=contact *} {* *} {*********************************************************} var jiffy : integer absolute $fc9e; logopr : byte absolute $fb02; forclr : byte absolute $f3e9; bakclr : byte absolute $f3ea; bdrclr : byte absolute $f3eb; dppage : byte absolute $faf5; acpage : byte absolute $faf6; VAR oldbak, oldbdr: byte; vdp_data : record sx,sy,dx,dy,nx,ny : Integer; color, options, commando: Byte; end; connorm : Integer; { ******************************************************************** } procedure clrscr; begin inline ($af/ { xor a } $fd/$2a/$c0/$fc/ { ld iy,(#fcc0) } $dd/$21/$c3/$00/ { ld ix,#c3 } $cd/$1c/$00); { call #1c } end; { ******************************************************************** } procedure color(fore,back,border: byte); begin forclr := fore; bakclr := back; bdrclr := border; inline ($fd/$2a/$c0/$fc/ { ld iy,(#fcc0) } $dd/$21/$62/$00/ { ld ix,#62 } $cd/$1c/$00); { call #1c } end; { ******************************************************************** } function dosver : Integer; var error : Byte; Kernel, DosVersion: Integer; begin inline ($0e/$6f/ { ld c,#6f } $cd/$05/$00/ { call 5 } $32/error/ { ld (error),a } $ed/$43/kernel/ { ld (kernel),bc } $ed/$53/DosVersion); { ld (dosversion),de } if error <> 0 then dosver := 0 else if hi(Kernel) < 2 then dosver := 256 else dosver := DosVersion; end; { ******************************************************************** } procedure setpalette (nr,r,g,b: Byte); begin inline ($ed/$5b/g/ { ld de,(g) } $3a/nr/$57/ { ld a,(nr): ld d,a } $3a/r/ { ld a,(rood) } $07/$07/$07/$07/ { 4* rlca } $47/ { ld b,a } $3a/b/$b0/ { ld a,(b): or b } $fd/$2a/$f7/$fa/ { ld iy,(#faf7) } $dd/$21/$4d/$01/ { ld ix,#014d } $cd/$1c/$00); { call #1c } end; { ******************************************************************** } procedure getpalette ( nr : Byte; var r,g,b: Byte); var r2,g2,b2: Byte; begin inline ($3a/nr/ $fd/$2a/$f7/$fa/ { ld iy,(#faf7) } $dd/$21/$49/$01/ { ld ix,#0149 } $cd/$1c/$00/ { call #1c } $79/$32/g2/ { ld a,c: ld (g2),a } $78/$e6/$0f/ { ld a,b: and 15 } $32/b2/ { ld (b2),a } $78/$07/$07/ { ld a,b: rlca: rlca } $07/$07/$e6/$0f/ { rlca: rlca: and 15 } $32/r2); { ld (r2),a } r := r2; g := g2; b := b2; end; { ******************************************************************** } procedure inipalette; begin inline ($fd/$2a/$f7/$fa/ { ld iy,(#faf7) } $dd/$21/$41/$01/ { ld ix,#0141 } $cd/$1c/$00); { call #1c } end; { ******************************************************************** } procedure setpage(acp,dpp: byte); begin dppage := dpp; acpage := acp; inline ($fd/$2a/$f7/$fa/ { ld iy,(#faf7) } $dd/$21/$3d/$01/ { ld ix,#013d } $cd/$1c/$00); { call #1c } end; { ******************************************************************** } function RomBios : Byte; var Versie: Byte; begin inline ($3a/$c1/$fc/ { ld a,(#fcc1 } $21/$2d/$00/ { ld hl,#2d } $cd/$0c/$00/ { call #0c ; rdslt } $32/Versie/ { ld (versie),a } $fb); { ei } RomBios := Versie; end; { ******************************************************************** } procedure SetCPU(mode:byte); begin if RomBios >= 3 then inline ($3a/mode/ { ld a,(mode) } $fd/$2a/$c0/$fc/ { ld iy,(#fcc0) } $dd/$21/$80/$01/ { ld ix,#180 } $cd/$1c/$00); { call #1c } end; { ******************************************************************** } function GetCPU: Byte; var mode: byte; begin if RomBios >= 3 then inline ($fd/$2a/$c0/$fc/ { ld iy,(#fcc0) } $dd/$21/$83/$01/ { ld ix,#183 } $cd/$1c/$00/ { call #1c } $32/mode) { ld (mode),a } else mode := 0; GetCPU := mode; end; { ******************************************************************** } procedure IniMulTurbo; begin IF (RomBios >= 3) AND { turbo r ??? } (mem[$6f5] = $4b) AND { en goede routine ?? } (mem[$6f6] = $42) { (==> zeker versie3.0) } THEN BEGIN mem[$6f7] := $ed; mem[$6f8] := $c3; { muluw bc } mem[$6f9] := $c9; { ret } IF GetCPU=0 THEN SetCPU ($81); { selecteer r800 !! } END; end; { ******************************************************************** } procedure RestMulTurbo; begin IF (RomBios >= 3) AND { turbo r ??? } (mem[$6f5] = $4b) AND { en goede routine ?? } (mem[$6f6] = $42) { (==> zeker versie3.0) } THEN BEGIN mem[$6f7] := $eb; { ex de,hl } mem[$6f8] := $7a; { ld a,d } mem[$6f9] := $b7; { or a } END; end; { ******************************************************************** } function readkey : char; var hulpchar : char; begin read (kbd,hulpchar); readkey := hulpchar; end; { ******************************************************************** } procedure setrd(addr:integer); begin inline ($fd/$2a/$c0/$fc/ $dd/$21/$6e/$01/ $2a/addr/ $cd/$1c/$00); end; { ******************************************************************** } procedure setwrt (addr:integer); begin inline($fd/$2a/$c0/$fc/ $dd/$21/$71/$01/ $2a/addr/ $cd/$1c/$00); end; { ******************************************************************** } procedure VDP(NR,DATA:BYTE); BEGIN inline ($3A/NR/ {LD A,(NR) } $4F/ {LD C,A } $3A/DATA/ {LD A,(DATA) } $47/ {LD B,A } $DD/$21/$47/$00/ {LD IX,VDP } $FD/$2A/$C0/$FC/ {LD IY,(SLOTIND) } $CD/$1C/$00) {CALL SLOT } END; { ******************************************************************** } function VdpStatus (NR:BYTE):BYTE; VAR HulpStatus : BYTE; BEGIN inline ($F3/ {DI } $3A/NR/ {LD A,(NR) } $D3/$99/ {OUT (#99),A } $3E/$8F/ {LD A,#8F } $D3/$99/ {OUT (#99),A } $F5/$F1/ {PUSH AF,POP AF } $DB/$99/ {IN A,(#99) } $32/HulpStatus/ {LD (HulpStatus),A } $AF/ {XOR A } $D3/$99/ {OUT (#99),A } $3E/$8F/ {LD A,#8F } $D3/$99/ {OUT (#99),A } $FB); {EI } VdpStatus := HulpStatus; END; { ******************************************************************** } procedure vdp_command (commando: byte); begin vdp_data.commando := commando; repeat until (VdpStatus(2) AND 1)=0; vdp(17,32); { vdp(17)=32 => control registers } inline ($21/vdp_data/ {LD HL,vdp_data } $01/$9B/$0F/ {LD BC,$0F9B } $ED/$B3) {OTIR } end; { ******************************************************************** } procedure Line2 (XB,YB,XE,YE,FUNCTIE:INTEGER;COLOR:BYTE); BEGIN inline ($2A/XE/ {LD HL,(X EIND) } $22/$B3/$FC/ {LD (GXPOS),HL } $2A/YE/ {LD HL,(Y EIND) } $22/$B5/$FC/ {LD (GYPOS),HL } $3A/COLOR/ {LD A,(COLOR) } $32/$F2/$F3/ {LD (C-CODE),A } $ED/$4B/XB/ {LD BC,(XBEGIN) } $ED/$5B/YB/ {LD DE,(YBEGIN) } $DD/$2A/FUNCTIE/ {LD IX,(FUNCTIE)} $FD/$2A/$F7/$FA/ {LD IY,(MSX-2) } $CD/$1C/$00); {CALL Line } END; { ******************************************************************** } procedure Line (XB,YB,XE,YE:INTEGER;COLOR:BYTE); VAR FUNCTIE: INTEGER; BEGIN FUNCTIE:=$0085; Line2 (XB,YB,XE,YE,FUNCTIE,COLOR); END; { ******************************************************************** } procedure LineBox (XB,YB,XE,YE:INTEGER;COLOR:BYTE); VAR FUNCTIE:INTEGER; BEGIN FUNCTIE:=$00C9; Line2 (XB,YB,XE,YE,FUNCTIE,COLOR); END; { ******************************************************************** } procedure FillBox (XB,YB,XE,YE:INTEGER;COLOR:BYTE); VAR FUNCTIE:INTEGER; BEGIN FUNCTIE:=$00CD; Line2 (XB,YB,XE,YE,FUNCTIE,COLOR); END; { ******************************************************************** } procedure Screen (N:BYTE); VAR tn : byte; BEGIN { if N<2 then conoutptr:=connorm else conoutptr:=addr(GRPPRT) ;} if (n<=8) then tn := n else tn := 8; inline ($3A/tn/ {LD A,(TN) } $FD/$2A/$C0/$FC/ {LD IY,(MSX-1)} $DD/$21/$5F/$00/ {LD IX,SCREEN } $CD/$1C/$00); {CALL SCREEN } if (n=10) or (n=11) then vdp(25, 24) { set YAE, YJK } else if (n=12) then vdp(25, 8); { set YJK } END; { ******************************************************************** } procedure Halt (error: byte); begin bakclr := oldbak; bdrclr := oldbdr; screen(0); inipalette; if hi(dosver) < 2 then inline($c7) { rst 0 } else inline($0e/$62/ { ld c,#62 } $3a/error/ { ld a,(error) } $47/ { ld b,a } $c3/$05/$00) { jp 5 } end; { ******************************************************************** } procedure Pset (dx,dy: Integer; color: byte); begin inline($F3/$01/$99/$8F/$11/$9B/$99/$3E/ $02/$ED/$79/$ED/$41/$ED/$78/$E6/ $01/$20/$FA/$3E/$24/$ED/$79/$3E/ $91/$ED/$79/$4B/$2A/dx /$ED/ $69/$ED/$61/$3A/dy /$ED/$79/ $3a/acpage / $ED/$79/$4A/$3E/$2C/$ED/$79/$3E/ $91/$ED/$79/$4B/$3A/color /$ED/ $79/$AF/$ED/$79/$3E/$50/$ED/$79/ $4A/$AF/$ED/$79/$3E/$8F/$ED/$79/ $FB) end; { ******************************************************************** } function Point(sx,sy: Integer): Byte; var color : byte; begin inline($F3/$01/$99/$8F/$11/$9B/$99/$3E/ $02/$ED/$79/$ED/$41/$ED/$78/$E6/ $01/$20/$FA/$3E/$20/$ED/$79/$3E/ $91/$ED/$79/$4B/$2A/sx /$ED/ $69/$ED/$61/$3A/sy /$ED/$79/ $3a/acpage / $ED/$79/$4A/$AF/$ED/$79/$3E/$AD/ $ED/$79/$3E/$40/$ED/$79/$3E/$AE/ $ED/$79/$F5/$F1/$ED/$78/$E6/$01/ $20/$FA/$3E/$07/$ED/$79/$ED/$41/ $ED/$78/$32/color /$AF/$ED/$79/ $ED/$41/$FB); point := color; end;