{$D+}
program KCEMU;
{$C MOVEABLE PRELOAD PERMANENT} {gleiche Attribute wie Unit SYSTEM}
{$D KC-Emulator 0.52 (02/00)}
{$S 65535}
{$R KCEMU.RES}
{$R ROMS.RES}
uses
WinTypes, WinProcs, MMSystem, Win31, CommDlg, ShellApi, WinDos,
WUtils,KCHdr,KCDeb;
{Eigene Laufzeitfehler:
220: kein Speicher bei GlobalAlloc() u.ä. Windows-Funktionen,
221: kein Speicher bei LocalAlloc() u.ä. Windows-Funktionen,
222: unerwarteter Offset <>0 bei globalem Speicher
223: Fenster-Handle Null, jedoch erforderlich}
type
TKCPixmap=record {Bitmap für KC85/2..4}
case Integer of
1: (bih: TBitmapInfoHeader; {der Header}
col: array[0..31] of Integer); {Paletten-Indizes}
2: (f0,f1,x,f3,y,f5,f6,b,f8,f9,fa,fb,fc,fd,fe,ff,c: Integer);
{zum einfacheren (16-bit-)Zugriff auf x,y und die Farbzahl}
3: (bi: TBitmapInfo); {Typecast für BitBlt}
end;
TKCPalette=record
palVersion: Word;
palNumEntries: Word;
col: array[0..31] of TColorRef; {alias LongInt}
end;
TThreeWords=array[1..3] of Word;
PArgs=^TArgs;
TArgs=record
argn: Byte; {Anzahl}
arg: TThreeWords; {Argumente}
end;
TKccHdr=record {23 Bytes}
name: array[0..10]of Char;
rsv: array[11..15]of Byte;
args: TArgs;
end;
TZ80Hdr=record {32 Bytes}
arg: TThreeWords; {00..05, Anfangs-, Ende- und Startadresse}
creator: array[0..5] of Char; {06..0B}
typ: Char; {0C C=COM}
magic: array[0..2] of Char; {0D..0F, Inhalt D3-D3-D3 oder '...'}
name: array[0..15] of Char; {10..1F, Dateiname}
end;
TFullKccHdr=record
case Integer of
0: (name: array[0..10]of Char;
rsv: array[11..15]of Byte;
args: TArgs);
1: (block: array[0..127] of Char);
end;
{Die anderen KC's arbeiten mit einer Bitmap (S/W),
abgesehen vom Z9001 mit Farboption.
Formate: KC85: Pixel 320x256, Zeichen 40x32, Zeichenraster 8x8
oder (WordPro) Zeichen 80x32, Zeichenraster 4x8
oder (CP/M) Zeichen 80x25, Zeichenraster 4x10
Z9001: Pixel 320x192, Zeichen 40x24, Zeichenraster 8x8
oder(!)Pixel 320x200, Zeichen 40x20, Zeichenraster 8x10
Z1013: Pixel 256x256, Zeichen 32x32, Zeichenraster 8x8}
{
FARBBYTE KC85:
Bit 7: 1=Blinken
Bit 6: Vordergrund-Farbkreisverschiebung um 30°
Bit 5..3: Vordergrundfarbe G-R-B
Bit 2..0: Hintergrundfarbe G-R-B in reduzierter Helligkeit
FARBBYTE Z9001:
Bit 7: 1=Blinken
Bit 6..4: Vordergrundfarbe B-G-R
Bit 3: frei
Bit 2..0: Hintergrundfarbe B-G-R
BILDSCHIRMRAND UND ZEILENUMSTELLUNG Z9001
Port 136 (88h):
Bit 5..3: Bildrandfarbe B-G-R (wird via WM_NCPaint emuliert)
Bit 2: 1=20-Zeilen-Modus mit 8x10-Zeichenzellen}
TCallEvent=function(Msg,wParam:Word; lParam:LongInt):LongInt;
const
AnimCol=PC_Reserved shl 24; {max. 8 Farbpaare werden animiert}
KCPixmap: TKCPixmap=(
bih: (
biSize: sizeof(TBitmapInfoHeader);
biWidth: 320; {variabel}
biHeight: 256; {variabel}
biPlanes: 1;
biBitCount: 8; {variabel}
biCompression: BI_RGB;
biSizeImage: 0;
biXPelsPerMeter: 0;
biYPelsPerMeter: 0;
biClrUsed: 32; {variabel}
biClrImportant: 0);
col:(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,
25,26,27,28,29,30,31)
);
type
PDefPal=^TDefPal;
TDefPal=record
num: Integer;
col: array[0..23] of TColorRef; {maximal 24 Festfarben zulässig}
end;
const
DefPal1: record {monochrome Palette}
num: Integer;
col: array[0..1] of TColorRef;
end=(num: 2;
col:($000000,$FFFFFF));
DefPal3: record {KC85/3-Palette}
num: Integer;
col: array[0..23] of TColorRef;
end=(num: 24;
col:($000000,$B00000,$0000B0,$B000B0,$00B000,$B0B000,$00B0B0,$B0B0B0,
$000000,$FF0000,$0000FF,$FF00FF,$00FF00,$FFFF00,$00FFFF,$FFFFFF,
$000000,$FF0080,$0080FF,$8000FF,$80FF00,$FF8000,$00FF80,$FFFFFF));
DefPal7: record {KC87-Palette}
num: Integer;
col: array[0..7] of TColorRef;
end=(num: 8;
col:($000000,$0000FF,$00FF00,$00FFFF,$FF0000,$FF00FF,$FFFF00,$FFFFFF));
function DefFetchInstruction:Byte; near; assembler;
asm seges lodsb
end;
procedure DefDoNothing; near; assembler;
asm
end;
function DefIORead:Byte; near; assembler;
asm mov al,$ff
end;
function DefCallEvent(Msg,wParam:Word; lParam:LongInt):LongInt; far; assembler;
asm xor ax,ax
cwd
end;
var
Palette: TKCPalette; {Momentane Palette}
PalPtr: PDefPal; {Statische Palette des jeweiligen Computers}
hDisplay: Word; {Windows-DIB mit 2 oder 256 Farben; Offset ist Null}
DisplaySize: LongInt; {Größe der Bitmap/Pixmap, max. 128KB}
cticks: LongInt;
expire: Word;
KCTyp: Integer;
MenuFlags: Integer;
Saum: TPoint; {Add-On von Client auf Fenster}
AppName: array[0..31] of Char;
KCName: array[0..31] of Char; {Beschränkung wegen Platz in Titelzeile}
hPal: HPalette;
ClrsRealized: Word;
KC4Port84H: Byte; {Bit 3: KC 85/4 im /HRG-Modus, Bit 2: Bild-Nr.}
KC4Port86H: Byte;
KCIRM: PtrRec; {KC85/(erst mal nur)4 Videospeicher}
{ KCMem: THandle; {64K oder 256K}
KC4Port88H: Byte; {auch für Z9001 benutzt}
KC4Port89H: Byte;
Z1013Port2: Byte;
Z1013Port8: Byte;
Z1013Key: Word; {Lo: Zeichen, Hi: Crtl,Shift}
WrPerm: array[0..3] of Word;
{Bits gesetzt, wenn Schreibzugriff erlaubt; pro Kilobyte ein Bit}
PortsOut: array[0..255] of TNearProc; {Prozedur-Offsets}
PortsIn: array[0..255] of TNearProc;
PortsInstL: array[0..255] of Word; {Port-Info Low-Byte}
const
FetchInstruction: Word=ofs(DefFetchInstruction); {Befehlslese-Prozedur}
MemWr: Word=ofs(DefDoNothing); {Speicherschreib-Routine}
IORd: Word=ofs(DefIORead);
IOWr: Word=ofs(DefDoNothing);
const
CallEvent: TCallEvent=DefCallEvent;
var
IRom: array[0..3] of THandle; {Initial-ROMs (max. 4)}
IRomAddr: array[0..3] of Word; {Einblend-Adressen}
hCharMap: THandle absolute IRom; {erster Initial-ROM ist Zeichensatz}
TickTaken: LongInt;
TimeTaken: Word;
EmuBlock: Byte; {Register: <>0: Z80 blockieren!
Bit 0: Block wegen modalem Fenster, Bit 1: wegen Icon,
Bit 2: wegen Hintergrund, Bit 4: wegen F9, Bit 5: wegen ungültiger DLL}
EmuBlockMask: Integer;
const
EmuShowClock: Integer=$A;
{Bit 0..1: 0: keine Anzeige, 1: Prozent, 2: MHz}
{Bit 2: Auch wenn Symbol, Bit 3: KC-Typ anzeigen}
var
KCClock: Word; {Taktfrequenz in Kilohertz}
LastPaintTime: Word; {Zeit für WM_Paint entscheided über Emu-Dauer}
Freq: Word; {Zuletzt gemessene Z80-Frequenz}
SelectedRegion: HRgn; {Momentane Markierung}
SelectedRect: TRect; {Momentane Markierung}
RandL,RandR: Integer; {Ränder links und rechts, 0&0=rechteckig}
LoadSaveArgs: TArgs; {Global ist eben einfacher zu handhaben!}
{*** WinG-Bereich ***}
type
PPointer=^Pointer;
PRGBQuad=^TRGBQuad;
var
WinGInst: THandle;
WinGDC: HDC;
WinGBM: HBitmap;
WinGBMMono: HBitmap;
{5 Funktionszeiger}
WinGCreateDC: function:HDC;
WinGCreateBitmap: function(WinGDC:HDC; const Header:TBitmapInfo;
ppBits:PPointer):HBitmap;
WinGSetDIBColorTable: function(WinGDC:HDC; StartIndex,NumberOfEntries:Word;
pColors:PRGBQuad):Word;
WinGStretchBlt: function(
hdcDest:HDC;nXOriginDest,nYOriginDest,nWidthDest,nHeightDest:Integer;
hdcSrc: HDC;nXOriginSrc, nYOriginSrc, nWidthSrc, nHeightSrc: Integer):Bool;
WinGBitBlt: function(
hdcDest:HDC;nXOriginDest,nYOriginDest,nWidthDest,nHeightDest:Integer;
hdcSrc: HDC;nXOriginSrc, nYOriginSrc:Integer):Bool;
const
Installed:Boolean=false; {Entscheidet über's automatische Speichern}
AutoInsert:Boolean=false; {künftig INS vor jedem ASCII senden!}
Blinken:Boolean=true;
Foreground:Boolean=true; {Momentan dargestellte Blinkfarbe, ist später
der Ausgang eines virtuellen D-Flip-Flops im KC (am Timer U856-Z80CTC)}
HelpFile:array[0..9]of Char='KCEMU.HLP';
MaxRegions: Word=1600; {begrenzt die Aufrufe von InvalidateRect()}
BorderRGB: TColorRef=$1000000; {High-Byte<>0: keine Hintergrundfarbe!}
UseWinG: Boolean=false;
var
InUpdate: array[0..159] of Byte; {pro Cursorpos ein Bit}
{Pro Bildschirmlöschen kommen so max. 1280 Aufrufe von InvalidateRect()
zusammen; immer noch besser als per-Pixel-Basis}
Regions: Word;
GetAnimIdx: Word;
Magnify: Integer; {enthält 1 (normal) oder 2 (doppelt)}
PixBox: Integer; {enthält Dimension einer 8x8-Box auf Bildschirm}
ChrBox: TPoint; {enthält Dimension der Zeichenzelle auf Bildschirm}
ChrBoxKC: TPoint; {enthält Dimension der Zeichenzelle am KC}
GC_ShortCircuit: Boolean; {Kurzschlußroutine: keine Garbage Collection}
BlinkFarben: array[0..7] of Byte;
{enthält KC-Farbattribute mit gesetztem Blinkbit (7) oder 0 für freie
Einträge. Korrespondiert zu den 8 animierten Farben der Farbpalette}
KCEmuVxDEntry: Pointer;
hWav: HWaveIn;
Waves: array[0..1] of THandle;
WaveOption,WaveOutDev,WaveInDev: Integer;
CurWaveHdr,NextWaveHdr: PWaveHdr; {ZeigerZeiger auf Daten}
ByteIndex: Word;
const
CurrentHelpFile: TS31='KCEMU.HLP'; {!! Test}
const
WAVBLK=5500;
MyWav: TPCMWaveFormat=(
wf:(
wFormatTag: WAVE_Format_PCM;
nChannels: 1;
nSamplesPerSec: 22050;
nAvgBytesPerSec: 22050;
nBlockAlign: 1);
wBitsPerSample: 8);
function SetBorder(NewBorder: Integer):Boolean;
var
Color: TColorRef;
begin
Color:=$1000000;
if NewBorder>=0 then Color:=Palette.col[NewBorder];
if Color<>BorderRGB then begin
BorderRGB:=Color;
RedrawWindow(MainWnd,nil,0,RDW_Frame or RDW_Invalidate);
end;
end;
procedure SetPalette(NewPal:PDefPal);
var
I: Integer;
DC: HDC;
begin
if PalPtr<>NewPal then begin
PalPtr:=NewPal;
Palette.palVersion:=$0300;
Palette.palNumEntries:=32;
if PtrRec(PalPtr).Ofs<>0 then begin
for I:=0 to PalPtr^.num-1 do Palette.col[I]:=PalPtr^.col[I];
end;
for I:=24 to 31 do Palette.col[I]:=AnimCol;{hier Animationsfarben setzen}
DC:=GetDC(MainWnd);
if hPal<>0 then begin
SelectPalette(DC,GetStockObject(Default_Palette),false);
DeleteObject(hPal);
end;
hPal:=CreatePalette(PLogPalette(@Palette)^);
SelectPalette(DC,hPal,false);
ClrsRealized:=0; {RealizePalette() erzwingen}
ReleaseDC(MainWnd,DC);
end;
end;
procedure Blink_GC; external;
{Garbage Collection für BlinkFarben: Durchbrowst die 80-KB-Pixmap
nach Einträgen zwischen 24 und 31 und entfernt Fehlreferenzen
aus BlinkFarben[]. Sind alle Farben in Beschlag, dann CY=1.
PE: CLD! VR: BX,CX}
procedure GetBlinkFarbe; external;
{PE: AL=(unverändertes) Farbattribut; PA:AL=Palettenindex}
{Funktioniert für alle KC durch Funktionszeiger für SetAnimColor}
procedure Animate; external;
procedure GetAnimIdx3; external;
procedure GetAnimIdx7; external;
{Invalidierungsfunktionen}
procedure InvalWnd; external;
{PE: -, PA: -, VR: alle außer DS,SI,SP,BP}
procedure Inval8x8; external;
{Invaliditiert Bildschirm-Bereich in 8x8-Klötzchen,
Eintrittspunkt für den Gebrauch durch externe Bildschirmsteuerungen
PE: DL=Zeile(Y), DH=Spalte(X) (also gerade andersherum als im PC-BIOS)
BX=eindeutiger Bit-Bezeichner für InUpdate-BitArray
VR: BX,CL,Flags}
procedure InvalChrBox; external;
{dieselbe Routine wie oben, jedoch in Zeichenzellen statt 8x8}
{Sammlung aller IRM_UpdateX-Routinen (die meisten berühren nur den
Videospeicher); PE: -, PA: -, VR: Flags}
procedure IRM_Update1; external;
procedure IRM_Update3; external;
procedure IRM_Update4; external;
procedure IRM_Update7; external;
procedure IRM_Update9; external;
{Sammlung aller IRM_AccessX-Routinen
PE: BX=Schreibadresse, (ES:BX bereits geschrieben), AL=Zeichen
PA: -, VR: Flags}
procedure IRM_Access1; external;
procedure IRM_Access3; external;
procedure IRM_Access4; external;
procedure IRM_Access7; external;
procedure IRM_Access9; external;
{$L KCSCR}
type
TUserInfo=record
hDrv: THandle;
hLib: THandle; {Da sind die ROMs}
memwrite: Pointer; {4 schnelle Prozeduren: Speicherschreiben}
ioread: Pointer; {Portlesen}
iowrite: Pointer; {Portschreiben}
intchk: Pointer; {Interrupttest}
{Alle anderen Ereignisse gehen über DriverProc}
user: LongInt; {für den Treiber zur freien Verwendung}
screen: TPoint; {(anfängliche) Bildschirmgröße in Pixeln}
color: Boolean;
freq: Word; {Nominelle Taktfrequenz}
rom: array[0..3] of LongRec; {4 ROMs sollten reichen}
ram: array[0..3] of LongRec; {4 RAMs sollten reichen}
end;
var
UserInfo: TUserInfo;
{Speicherschreibroutinen mov [ES:BX],AL
PE: BX=Speicheradresse, AL=Zu schreibendes Byte; PA: -; VR: -}
procedure MemWrite1; near; assembler;
asm cmp bh,0C0h
jb @@set ;{0000-BFFF=RAM (bei 48K-Ausbau}
cmp bh,0ECh
jb @@e ;{C000-EBFF=ROM-Modul (BASIC) oder frei}
cmp bh,0F0h
jnb @@e ;{EC00-EFFF=IRM, dahinter ROM}
@@irm: cmp [es:bx],al
jz @@e
mov [es:bx],al
jmp IRM_Access1
@@set: mov [es:bx],al
@@e:
end;
type
{TSegment macht sich wegen des 64K-Moduls und des KC85/2-CAOS erforderlich}
TSegment=record {beschreibt ein Speicherabschnitt eines Moduls}
a,e:ShortInt; {Anfang und Ende der Einblendung im 64KB-Adreßraum}
r:Integer; {Referenz auf allozierten Speicherblock}
end;
PMemNode=^TMemNode;
TMemNode=record
next: Word; {nächstes Listenelement}
memblock: THandle; {Typ des memblock steht in segments[7:4]}
size: Word; {Größe des Speichermoduls in KByte}
switchproc: TNearProc;{Schalt-Prozedur}
strukturbyte: Byte; {Rückmeldung beim IN-Befehl}
steuerbyte: Byte; {Merker für letztes Steuerbyte; Bit0=On, Bit1=WrPerm}
steckplatz: Byte; {Modulsteckplatz; 0..7: interne Module}
segments: Byte; {Anzahl Segmente (siehe unten) Bit3:0}
seg: array[0..3] of TSegment;
end;
const
SegStart=12; {Bytes bis zu seg[0] - integrierter ASM macht Mist}
MEMT_None=0; {nicht alloziert}
MEMT_ResID=1; {memblock enthält Resourcen-ID zum Laden}
MEMT_Global=2; {memblock enthält PageAlloc()-Speicher}
MEMT_Res=3; {memblock enthält LoadResource()-Speicher}
var
NodeRam0, NodeIRM, NodeBasic, NodeCAOS: Word;
procedure MemWrite3; near; assembler;
{PE: ES:BX=Adresse, AL=Datenbyte; VR: Flags, CL}
asm push bx
shr bx,10 ;{Kilobyte}
cmp [Test8086],2
jb @@For286
db 0Fh,0A3h,1Eh ;{BT [WrPerm],bx}
dw offset WrPerm
pop bx
jnc @@e ;{keine Schreiberlaubnis!}
@@w286: cmp bh,80h
jb @@set ;{nicht im Bereich des IRM}
cmp bh,0b2h
jae @@set ;{nicht im Bereich des IRM}
test [KC4Port88H],4 ;{IRM eingeschaltet?}
jz @@set ;{nur schreiben}
cmp [es:bx],al
jz @@e ;{keine Veränderung}
mov [es:bx],al
jmp IRM_Access3 ;{DIB aktualisieren}
@@For286:
push ax
mov al,1
mov cl,bl
and cl,7 ;{Bit-Nummer}
shl al,cl ;{Bit in Position bringen}
shr bl,3 ;{BH ist bereits 0}
test byte ptr [WrPerm+bx],al
pop ax
pop bx
jnz @@w286
ret
@@set: mov [es:bx],al
@@e:
end;
{ alte Version
procedure MemWrite3; near; assembler;
asm cmp bh,0c0h
jae @@e
cmp bh,80h
jb @@set
cmp bh,0b2h
jae @@set
cmp [es:bx],al
jz @@e
mov [es:bx],al
jmp IRM_Access3
@@set: mov [es:bx],al
@@e:
end;
}
procedure MemWrite4; near; assembler;
{PE: ES:BX=Adresse, AL=Datenbyte; VR: Flags, CL}
asm cmp bh,0c0h
jae @@e
cmp bh,80h
jb @@set
cmp bh,0A8h
jae @@set
test [KC4Port88H],4 {IRM eingeschaltet?}
jz @@set {nein, normaler RAM}
cmp [es:bx],al
jz @@e
mov [es:bx],al
jmp IRM_Access4
@@set: mov [es:bx],al
@@e:
end;
procedure MemWrite7; near; assembler;
{PE: ES:BX=Adresse, AL=Datenbyte; VR: Flags, CL}
asm cmp bh,0C0h
jb @@set ;{0000-BFFF=RAM (bei 48K-Ausbau}
cmp bh,0E8h
jb @@e ;{C000-E7FF=ROM-Modul (BASIC)}
cmp bh,0F0h
jnb @@e ;{E800-EFFF=IRM, dahinter ROM}
@@irm: cmp [es:bx],al
jz @@e
mov [es:bx],al
jmp IRM_Access7
@@set: mov [es:bx],al
@@e:
end;
procedure MemWrite8; near; assembler;
{PE: ES:BX=Adresse, AL=Datenbyte; VR: Flags, CL}
asm cmp bh,0ECh
jb @@set ;{0000-EBFF=RAM (bei 64K-Ausbau}
cmp bh,0F0h
jb @@irm ;{EC00-EFFF=IRM}
ret ;{F000-FFFF=ROM-nicht schreiben}
@@irm: cmp [es:bx],al
jz @@e
mov [es:bx],al
jmp IRM_Access9
@@set: mov [es:bx],al
@@e:
end;
procedure MemWrite9; near; assembler;
{PE: ES:BX=Adresse, AL=Datenbyte; VR: Flags, CL}
asm cmp bh,0ECh
jb @@set ;{0000-EBFF=RAM (bei 64K-Ausbau}
cmp bh,0F0h
jb @@irm ;{EC00-EFFF=IRM}
cmp bh,0F8h
jae @@set ;{F800-FFFF=RAM (bei 64K-Ausbau)}
ret ;{F000-F7FF=ROM-nicht schreiben}
@@irm: cmp [es:bx],al
jz @@e
mov [es:bx],al
jmp IRM_Access9
@@set: mov [es:bx],al
@@e:
end;
procedure MemWriteUsr; near; assembler;
{PE: ES:BX=Adresse, AL=Datenbyte; VR: Flags, CL}
asm call [UserInfo.memwrite] {FAR weiterreichen}
end;
procedure DefMemWrite; near; assembler;
{PE: ES:BX=Adresse, AL=Datenbyte; VR: Flags, CL}
asm mov [es:bx],al
end;
(*
procedure XchgD(var a1,a2; len:Word); assembler;
asm pusha; push ds; push es
cmp [Test8086],2 {386er?}
cld
mov cx,[len]
jcxz @@e
lds si,[a1]
les di,[a2]
jnc @@l3
shl cx,1
@@l2: lodsw
mov dx,es:[di]
stosw
mov [si-2],dx
loop @@l2
jmp @@e
@@l3: db $66; lodsw
db $66; mov dx,es:[di]
db $66; stosw
db $66; mov [si-4],dx
loop @@l3
@@e: pop es; pop ds; popa
end;
*)
procedure MovK(SSel,SOfs,DSel,DOfs:Word; KBytes:Integer); assembler;
{maximal 64K am Stück! Kein Selektor-Übergang! Offsets in Kilobyte!
Bearbeitet später auch Speicherblöcke >64K}
asm push ds
mov cx,[KBytes]
jcxz @@e
shl cx,9 {Words}
mov al,[Test8086]
cld
lds si,dword ptr [SOfs] {jetzt ist DS weg!}
les di,dword ptr [DOfs]
shl si,10
shl di,10
cmp al,2 {386er?}
jc @@286
shr cx,1 {DWords}
db $66
@@286: rep movsw
@@e: pop ds
end;
procedure FillK(DSel,DOfs:Word; KBytes:Integer); assembler;
{maximal 64K am Stück! Kein Selektor-Übergang! Füllt mit $FF!
Bearbeitet später auch Speicherblöcke >64K}
asm mov cx,[KBytes]
jcxz @@e
shl cx,9 {Words}
cld
les di,dword ptr [DOfs]
shl di,10
mov ax,$FFFF
cmp [Test8086],2 {386er?}
jc @@286
shr cx,1 {DWords}
db $66; cbw {cwde, AX-->EAX}
db $66
@@286: rep stosw
@@e: end;
procedure SetWrPerm(frombit,tobit:Word; SetRes:Boolean); assembler;
asm cmp [test8086],2
jnc @@386
mov cx,frombit
mov dx,tobit
inc dx
sub dx,cx {Bit-Zahl}
mov bx,cx
shr bx,4
add bx,offset WrPerm
and cl,0Fh
mov ax,1
shl ax,cl
xchg cx,dx
cmp [SetRes],0
jz @@res286
@@set286:
mov dx,[bx] {im Register ORen, wegen Geschwindigkeit}
@@s2L: or dx,ax
rol ax,1
jc @@s21 {Bit-Ausschub? DX wechseln!}
loop @@s2L
inc cx {wenn geschafft, nur noch speichern}
@@s21: mov [bx],dx
add bx,2
loop @@set286
jmp @@e
@@res286:
not ax
mov dx,[bx] {im Register ORen, wegen Geschwindigkeit}
@@r2L: and dx,ax
rol ax,1
jnc @@r21 {Bit-Ausschub? DX wechseln!}
loop @@r2L
inc cx {wenn geschafft, nur noch speichern}
@@r21: mov [bx],dx
add bx,2
loop @@res286
jmp @@e
@@386:
mov cx,tobit
mov dx,frombit
inc cx
sub cx,dx {CX=Bit-Anzahl}
cmp [SetRes],0
jz @@res386
@@set386:
db 0Fh,0ABh,16h {BTS [WrPerm],dx}
dw offset WrPerm
inc dx
loop @@set386
jmp @@e
@@res386:
db 0Fh,0B3h,16h {BTR [WrPerm],dx}
dw offset WrPerm
inc dx
loop @@res386
@@e: end;
{Das kniffligste scheint die Speicher-Emulation zu sein}
function PageAlloc(KBytes:Integer):THandle; far;
{KBytes MSB: Allokation von ständig gemapptem Speicher: es erfolgt dann
KEIN GlobalAlloc, jedoch im VxD dennoch PageAllocate}
{Belegt später im VxD}
begin
if KBytes<0 then PageAlloc:=MemKCSel
else if PtrRec(KCEmuVxDEntry).Sel=0 then begin
if KBytes=0 then KBytes:=64; {Sonderfall: 64K-Fenster}
PageAlloc:=GlobalAlloc(GMEM_Fixed,LongMul(KBytes,1024))
end else asm
mov ah,1
call [KCEmuVxDEntry]
mov [@Result],ax
end;
end;
function PageFree(HMem:THandle):THandle;
{gibt später im VxD frei, sollte 0 liefern}
{"Normaler" Speicher mit Handle=MemKCSel NICHT freigeben!}
begin
PageFree:=0;
if HMem<>0 then begin
if PtrRec(KCEmuVxDEntry).Sel=0 then PageFree:=GlobalFree(HMem)
else asm
mov ah,2
call [KCEmuVxDEntry]
mov [@Result],ax
end;
end;
end;
procedure Map(KCKB:Integer;HMem:THandle;Start,KBytes:Integer; Dir:Boolean);
{Speicher ab Adresse KCOfs ein/ausblenden, Start in KBytes vom HMem-Anfang}
{Wird später ins VxD verlegt und von der MMU erledigt}
begin
if HMem<>0 then begin {Speicherhandle okay?}
if Dir then MovK(HMem,Start,MemKCSel,KCKB,KBytes)
{Dir=TRUE: MapIn}
else MovK(MemKCSel,KCKB,HMem,Start,KBytes);
{Dir=FALSE: MapOut}
end else begin
if Dir then FillK(MemKCSel,KCKB,KBytes);
{Dir=TRUE: Speicherloch simulieren}
end; {Dir=FALSE: Nichts tun}
end;
var
MemChain: Word; {Listen-Anker (im Grundgerät); nur KC85}
IoChain: Word; {noch ein Listen-Anker für Standard-IO}
function LoadROM(ID:Word):THandle; forward;
procedure ShuffleMem(N:Word; start,endi:ShortInt; Richtung:Integer);
{Speicher ein- oder auslagern, Richtung=0: vom MemKCSel, =1: zum MemKCSel,
2: Speicher mit $FF füllen; start, endi in KByte (0..63)
Diese Routine lädt ggf. die Resource beim Einblenden bzw. reserviert
Speicher beim Ausblenden}
begin
with PMemNode(Ptr(Seg(HInstance),N))^ do case Richtung of
0: begin {"Rückzieher"}
if segments shr 4 =0 then begin
memblock:=PageAlloc(size);
segments:=segments or $20;
end;
MovK(MemKCSel,start, memblock,seg[0].r+start-seg[0].a,
endi-start+1);
{Beim "Rückzieher" ist kein Setzen von Schreibfreigabe-Bits nötig}
end;
1: begin {"Einmapper"}
if segments shr 4 =1 then begin
memblock:=LoadROM(memblock);
segments:=segments or $20;
end;
if memblock<>0
then MovK(memblock,seg[0].r+start-seg[0].a, MemKCSel,start,
endi-start+1);
{Schreibfreigabe-Bits je nach N^.flags setzen/löschen}
SetWrPerm(start,endi,steuerbyte and 2 <>0);
end;
2: begin
FillK(MemKCSel,start,endi-start+1);
{Schreibfreigabe-Bits löschen}
SetWrPerm(start,endi,false);
end;
end;
end;
procedure SchalteEinAus(EinblendNode:Word; Ein:Boolean);
{Ein- oder Ausschalten von EinblendNode}
procedure Speicherkette(N:Word;start,endi:ShortInt;Dahinter:Boolean);
var
S,E:ShortInt;
begin
with PMemNode(Ptr(Seg(HInstance),N))^ do begin
if N=0 then begin
{ $FF einblenden}
if Dahinter and not Ein then ShuffleMem(0,start,endi,2);
exit;
end;
if EinblendNode<>N then begin
if steuerbyte and 1 <>0 then begin {RAM eingeschaltet?}
{Schnittmenge sichern, wenn hinter EinblendNode}
if Dahinter then begin
S:=max(start,seg[0].a);
E:=min(endi,seg[0].e); {Schnittmenge vorhanden?}
if S<=E then ShuffleMem(N,S,E,Integer(not Ein));
end; {mit Differenzmenge weiter rekursieren}
{Bereich oder Teilbereich davor?}
S:=seg[0].a;
if (start<S) then Speicherkette(next,start,min(endi,S-1),Dahinter); {Bereich dahinter?}
E:=seg[0].e;
if (E<endi) then Speicherkette(next,max(start,E+1),endi,Dahinter);
end else Speicherkette(next,start,endi,Dahinter);
end else begin
if not Ein then ShuffleMem(N,start,endi,0);
SpeicherKette(next,start,endi,true); {Durch-rekursieren!}
if Ein then ShuffleMem(N,start,endi,1);
end;
end;
end;
begin
with PMemNode(Ptr(Seg(HInstance),EinblendNode))^ do begin
SpeicherKette(MemChain,seg[0].a,seg[0].e,false);
steuerbyte:=steuerbyte and not 1 or Integer(Ein);
end;
end;
procedure SchalteSchreibfreigabe(EinblendNode:Word; Perm:Boolean);
{Nur aufrufen, wenn sich bei eingeschaltetem Modul ausschließlich
das Schreibschutz-Bit ändert! Kein Schaufeln/Mapping in dieser Routine.}
procedure Speicherkette(N:Word;start,endi:ShortInt);
var
S,E:ShortInt;
begin
with PMemNode(Ptr(Seg(HInstance),N))^ do begin
if N=0 then exit; {nichts tun!}
if EinblendNode<>N then begin
if steuerbyte and 1 <>0 then begin {RAM eingeschaltet?}
S:=seg[0].a; {Bereich oder Teilbereich davor?}
if (start<S) then Speicherkette(next,start,min(endi,S-1));
E:=seg[0].e; {Bereich oder Teilbereich dahinter?}
if (E<endi) then Speicherkette(next,max(start,E+1),endi);
end else Speicherkette(next,start,endi);
{ausgeschaltete Module ignorieren}
end else begin
SetWrPerm(start,endi,Perm);{nun Schreibschutz setzen/löschen}
end;
end;
end;
begin
with PMemNode(Ptr(Seg(HInstance),EinblendNode))^ do begin
SpeicherKette(MemChain,seg[0].a,seg[0].e);
steuerbyte:=(steuerbyte and not 2) or (Integer(Perm) shl 1);
end;
end;
procedure FillWord(var buf; words:Word; val: Word); assembler;
asm les di,[buf]
mov cx,[words]
mov ax,[val]
cld
rep stosw
end;
function InsertKCModul(N: Word):Boolean; assembler;
{Diese Funktion liefert FALSE, wenn der Steckplatz bereits belegt ist!}
{Schleifen-Körper: BX=Einfüge-Node, SI=Vorgänger-Node, DI=Nachfolger-Node}
asm mov di,offset MemChain
mov bx,[N]
mov ah,TMemNode[bx].steckplatz
@@l: mov si,di
mov di,[di]
or di,di
jz @@break
mov al,TMemNode[di].steckplatz
cmp al,ah
jz @@err {gleich: Fehler!}
jc @@l {kleiner: Schleife wiederholen!}
@@break:
mov [bx],di {N^.next einsetzen}
mov [si],bx {Vorgänger^.next einsetzen}
test TMemNode[bx].steuerbyte,1
jz @@off
push bx
push 1
call SchalteEinAus {Voraussetzung: Segmentadressen initialisiert}
@@off: mov al,1
jmp @@e
@@err: int 3
mov al,0
@@e: end;
procedure FindKCModul; assembler;
{PE: AH=Steckplatz; PA: SI=PMemNode, CY=1: nicht gefunden;
VR: SI, Flags}
asm mov si,offset MemChain
@@l: mov si,[si]
or si,si
stc
jz @@e {Fehler bei NIL}
cmp ah,TMemNode[si].steckplatz
ja @@l {Fehler bei AH<AL}
@@e: end;
function RemoveKCModul(N: Word):Boolean; assembler;
{N muß sich in der Liste wiederfinden lassen;
N wird nur aus der Liste entfernt, wird jedoch selbst nicht freigegeben}
asm mov bx,[N]
test TMemNode[bx].steuerbyte,1
jz @@off
push bx
push 0
call SchalteEinAus
mov bx,[N] {Nachladen!!}
or TMemNode[bx].steuerbyte,1
@@off: mov di,offset MemChain
mov al,0 {FALSE}
@@l: mov si,di
mov di,[di]
or di,di
jz @@e
cmp di,bx {Gleich?}
jne @@l {nein, weitersuchen}
mov ax,[di]
mov [si],ax {Knoten (DI=BX) aushängen}
mov al,1 {TRUE}
@@e: end;
procedure ClearKCModules; assembler;
asm xor di,di
xchg di,[MemChain] {gleichzeitig nullsetzen}
jmp @@f
@@l:
mov cx,TMemNode[di].memblock
jcxz @@1
push di
mov al,TMemNode[di].segments
shr al,4
cmp al,MEMT_Res {Ressource extra freigeben!}
je @@fr {sonst hagelt es Schutzverletzungen}
cmp al,MEMT_Global
jne @@fm
push cx
call PageFree
jmp @@fm
@@fr: push cx
call FreeResource
@@fm: pop di
@@1: push di
mov di,[di] {NEXT holen}
call LocalFree
@@f: or di,di
jnz @@l
end;
function LocalAllocW(siz:Word):Word;
begin
siz:=LocalAlloc(LPTR,siz);
if siz=0 then RunError(221);
LocalAllocW:=siz;
end;
type {Standardbauelemente-Liste (in der IEI-IEO-Kette)}
PIoNode=^TIoNode;
TIoNode=record
next: Word; {nächstes Listenelement}
eventproc: TNearProc; {Ereignis-Prozedur mit msg, wParam und lParam}
steckplatz: Byte;
devs: Byte;
sizeperdev: Word;
case Integer of
0: (data: array[0..0] of Char);
{ 855: pio: TPIO;}
{ 856: sio: TSIO;}
857: (ctc: TCTC);
{ 858: dma: TDMA;}
{ 8272: fdc: TFDC;}
end;
const {Nachrichten für EventProc}
SIZE_IoNode_Header=8;
IOEV_GetDataSize=1; {Ermitteln der Größe der benötigten Zusatzdaten}
IOEV_InitData=2; {Initialisieren von Datenfeldern, insbesondere Sprungadressen}
IOEV_Connect=3; {Anschließen der peripheren Leitungen}
IOEV_IAck=4; {Interrupt-Bestätigungs-Zyklus der CPU}
IOEV_RETI=5; {RETI-Zyklus (Interrupt-Ende)}
IOEV_Reset=7; {RESET-Signal für den Chip}
IOEV_Destroy=7; {Entfernung des Chips; zunächst wie RESET}
IOEV_Load=9; {Laden eines gespeicherten Zustandes}
IOEV_Save=10; {Speichern eines Momentanzustandes}
procedure MakeRepIoNodeCall; assembler;
{PE: AH=Message, AL=MaxQuery (0=keine Abfrage), DI=PIoNode
PA: bei CY=1:
AX=Ergebnis
CL=Steckplatzschacht
CH=Gerätenummer (0-basiert)
bei CY=0:
CL=Steckplatzchacht
CH=min(devs,MaxQuery)
VR: AL,BX,CX,DX,DI - weitere (SI) je nach Callback
Schleife bricht vorzeitig ab, wenn ein Callback CY setzt
Der Callback wird aufgerufen mit:
AH=Message, DI=Geräte-interner Strukturzeiger,
CH=Gerätenummer, CL=Steckplatz, BX=Strukturgröße (von AH=1).
Der Callback darf alle Register außer SI und DI (und BP sowieso) verändern}
asm mov cx,word ptr TIoNode[di].steckplatz {CH=devs}
cmp al,ch
jc @@min
xchg ch,al
@@min: mov ch,0
or al,al
jz @@e {Das war's, nichts weiter}
mov bx,TIoNode[di].sizeperdev
mov dx,TIoNode[di].eventproc
add di,SIZE_IoNode_Header
@@l: push ax
push bx
push cx
push dx
call dx {darf DI nicht verändern!}
pop dx
pop cx
pop bx
jc @@ex
pop ax
inc ch
add di,bx
dec al
jnz @@l
ret
@@ex: pop dx {Stack-Wert verwerfen}
@@e:
end;
function MakeIoNode(EventP: TNearProc; Steck:Word):Word; assembler;
{Erzeugt eine Instanz (Speichereinheit) für ein Standard-Peripherieelement,
welches fortan mit dem Returnwert (Zeiger auf lokalen Speicher) angesprochen
werden kann. Der Steckplatz ist für die spätere Einfüge-Sortierreihenfolge
wichtig. Gelöscht wird der entstandene Node mit LocalFree().
MakeIoNode liefert immer ein gültiges Handle;
bei Speichermangel erfolgt Programm-Abbruch}
asm mov dx,[EventP]
push dx
mov ah,IOEV_GetDataSize
call dx
{liefert AH=NumDevs und AL=SizePerDev}
push ax
mul ah
add ax,SIZE_IoNode_Header
push ax
call LocalAllocW
xchg di,ax
pop ax
mov TIoNode[di].devs,ah
cbw
mov TIoNode[di].sizeperdev,ax
pop dx
mov TIoNode[di].eventproc,dx
mov ax,[Steck]
mov TIoNode[di].steckplatz,al
push di {für Returnwert}
mov ax,IOEV_InitData*256+0FFh
call MakeRepIoNodeCall {NumDev-mal aufrufen}
pop ax
end;
procedure InsertIoNode(N: Word); assembler;
{Im Gegensatz zu InsertKCModul() gibt's hier niemals FALSE. Bei identischem
Steckplatz wird hinter vorhandenen Einheiten auf gleichem Steckplatz
eingefügt}
{Schleifen-Körper: BX=Einfüge-Node, SI=Vorgänger-Node, DI=Nachfolger-Node}
asm mov di,offset IoChain
mov bx,[N]
mov ah,TIoNode[bx].steckplatz
@@l: mov si,di
mov di,[di]
or di,di
jz @@break
mov al,TIoNode[di].steckplatz
cmp al,ah
jbe @@l {kleiner oder gleich: Schleife wiederholen!}
@@break:
mov [bx],di {N^.next einsetzen}
mov [si],bx {Vorgänger^.next einsetzen}
end;
function RemoveIoNode(N: Word):Boolean; assembler;
{N muß sich in der Liste wiederfinden lassen;
N wird nur aus der Liste entfernt, wird jedoch selbst nicht freigegeben}
asm mov bx,[N]
mov di,offset IoChain
xor ax,ax {FALSE}
@@l: mov si,di
mov di,[di]
or di,di {NIL?}
{$IFOPT D+}
jnz @@found
INT 3
jmp @@e
@@found:
{$ELSE}
jz @@e
{$ENDIF}
cmp di,bx {Gleich?}
jne @@l {nein, weitersuchen}
mov [bx],ax {next-Feld nullsetzen}
mov ax,[di]
mov [si],ax {Knoten (DI=BX) aushängen}
inc ax {TRUE}
@@e: end;
procedure ClearIoNodes; assembler;
{Alle IO-Nodes löschen}
asm xor di,di
xchg di,[IoChain] {gleichzeitig nullsetzen}
jmp @@f
@@l:
push di
mov di,[di] {NEXT holen}
call LocalFree
@@f: or di,di
jnz @@l
end;
procedure DispatchIOWrite; near; assembler;
asm mov di,ax
and di,0FFh
shl di,1
jmp word ptr [PortsOut+di]
end;
procedure SwitchM022; assembler;
{Aufruf mit si=Objektzeiger, bl=neues Steuerbyte; VR: alle}
asm
{1.: Test, ob sich überhaupt etwas ändert}
mov al,bl
xor al,TMemNode[si].steuerbyte
and al,0c3h {unwesentliche Bits ausmaskieren}
jz @@e {Wenn sich gar nichts ändert: raus!}
{2.: Test, ob nur das Schreibfreigabe-Bit geschaltet werden soll}
cmp al,2 {das einzige, was sich ändern darf!}
jnz @@nowr
mov al,bl
test al,1
jz @@nowr {betrifft nur eingeschaltete Module}
push si {EinblendNode}
and ax,2
shr ax,1
push ax {neue Schreibfreigabe}
call SchalteSchreibfreigabe
jmp @@e
{3.: Eventuell eingeschaltetes Modul ausschalten}
@@nowr:
test TMemNode[si].steuerbyte,1
jz @@no_off
pusha {Register retten}
push si
push 0
call SchalteEinAus
popa
@@no_off:
{4.: fertig, wenn Modul nur ausgeschaltet wird}
test bl,1
jz @@e {fertig, wenn's ausbleiben soll}
{5.: Neue Einblendadressen eintragen}
mov al,bl
mov TMemNode[si].steuerbyte,al {eintragen}
shr al,2
and al,30h
mov TSegment[si+SegStart].a,al
add ax,15 {15KB}
mov TSegment[si+SegStart].e,al
{5.: Modul (an neuer Adresse) einschalten}
push si
push 1
call SchalteEinAus
@@e:
end;
procedure IOW80; near; assembler;
{Modulsteuerung, hier: 16K-Modul M022}
asm cmp ah,08
jc @@e
{und nun ist in BL das Steuerbyte}
pusha
push es
call FindKCModul
jc @@e1
call TMemNode[si].switchproc
@@e1: pop es
popa
@@e:
end;
procedure KC3IOW88; near; assembler;
asm push ax
mov al,bl
xchg al,[KC4Port88H]
xor al,bl
test al,80h
jz @@nobasic
pusha
push es
shr bl,7
push word ptr [NodeBasic]
push bx
call SchalteEinAus
pop es
popa
@@nobasic:
test al,4 {IRM ein/aus}
jz @@noirm
pusha
push es
shr bl,2
and bl,1
push word ptr [NodeIRM]
push bx
call SchalteEinAus
pop es
popa
@@noirm:
pop ax
end;
procedure KC3IOW89; near; assembler;
asm mov [KC4Port89H],bl
end;
(*
procedure IOWrite3; near; assembler;
asm cmp al,80h
jne @@joj
jmp IOW80
@@joj: cmp al,89h
jnz @@w1
mov [KC4Port89H],bl
jmp @@e
@@w1: cmp al,88h
jnz @@e
push ax
mov al,bl
xchg al,[KC4Port88H]
xor al,bl
test al,80h
jz @@nobasic
pusha
push es
shr bl,7
push word ptr [NodeBasic]
push bx
call SchalteEinAus
pop es
popa
@@nobasic:
test al,4 {IRM ein/aus}
jz @@noirm
pusha
push es
shr bl,2
and bl,1
push word ptr [NodeIRM]
push bx
call SchalteEinAus
pop es
popa
@@noirm:
pop ax
@@e: end;
*)
procedure SetNewPixmap(x,y:Integer; Bunt:Boolean); forward;
procedure ChrBoxChanged; assembler;
{bei Veränderungen der Bildgröße oder ChrBoxKC muß ChrBox nachgeführt werden}
asm mov cx,[Magnify]
mov ax,[ChrBoxKC.X]
mul cl
mov [ChrBox.X],ax
mov ax,[ChrBoxKC.Y]
mul cl
mov [ChrBox.Y],ax
mov al,8
mul cl
mov [PixBox],ax {für Inval8x8}
end;
procedure IOWZ88; near; assembler;
asm
pusha
push es
mov al,bl
xchg al,[KC4Port88H]
xor al,bl
test al,4 ;{Bit-Veränderung: Videomodus-Umschaltung?}
jz @@e1 ;{nein}
test bl,4
jz @@a1
mov [ChrBoxKC.Y],10
call ChrBoxChanged
push 320
push 200
jmp @@w1
@@a1:
mov [ChrBoxKC.Y],8
call ChrBoxChanged
push 320
push 192
@@w1: mov al,true
cmp [KCTyp],7 ;{in Farbe?}
sbb al,0
push ax
call SetNewPixmap ;{Speicherlöschung hier nicht erforderlich}
mov ax,offset IRM_Update1
cmp [KCTyp],7 ;{Welches Update bitteschön?}
jne @@b1
mov ax,offset IRM_Update7
@@b1: call ax
@@e1: cmp [KCTyp],7 ;{Bildrandfarbe ändern?}
jne @@e2
mov al,[KC4Port88H]
and ax,38h
shr ax,3 ;{Index zurechtschieben}
push ax
call SetBorder ;{Rand ggf. ändern (lassen)}
@@e2: pop es
popa
end;
procedure IOW4_88; near; assembler;
asm
push ax
mov al,bl
xchg al,[KC4Port88H]
xor al,bl ;{Bit-Veränderungen}
test al,80h ;{Betrifft BASIC-ROMC?}
jz @@1
test [KC4Port86H],80h {CAOS ROMC eingeschaltet?}
jnz @@1 ;{Nichts tun! (der ist höherpriorisiert)}
pusha
push es
push 48 ;{ab 48K (0c000h)}
test bl,80h ;{EIN oder AUS?}
jnz @@ein
push 0
jmp @@aus
@@ein: push word ptr [IRom+4] {HC-BASIC}
@@aus: push 0 ;{Start im Segment}
push 8 ;{Kilobytes}
push 1
call map
pop es
popa
@@1: pop ax
end;
procedure IOW4_89; near; assembler;
asm
push ax
mov al,bl
xchg al,[KC4Port89H]
xor al,bl ;{Bit-Veränderungen}
test al,80h ;{Betrifft Blinken?}
jz @@1
@@1: pop ax
end;
procedure IOW4_84; near; assembler;
asm
push ax
mov al,bl
xchg al,[KC4Port84H]
xor al,bl ;{Bit-Veränderungen}
test al,6 ;{Pixel/Farb- oder Bild-Umschaltung?}
jz @@1
pusha
push es
push 32 ;{ab 32K (8000h)}
push [KCIRM].Sel
mov al,[KC4Port84H]
and ax,6
shl ax,13
mov [KCIRM].Ofs,ax ;{neu!}
shr ax,10 ;{in Kilobytes}
push ax
push 10 ;{Kilobytes}
push true
call Map ;{Map-In, kein Map-Out erforderlich!}
pop es
popa
@@1: test al,9 ;{Modus- oder Bild-Umschaltung?}
jz @@2
call IRM_Update4 ;{Komplett neu zeichnen}
@@2: pop ax
end;
procedure IOW4_86; near; assembler;
asm
push ax
mov al,bl
xchg al,[KC4Port86H]
xor al,bl ;{Bit-Veränderungen}
test al,80h ;{Betrifft CAOS-ROMC?}
jz @@1
pusha
push es
push 48 ;{ab 48K (0c000h)}
test bl,80h ;{EIN oder AUS?}
jnz @@caos
test [KC4Port88H],80h
jnz @@basic
push 0
jmp @@aus
@@caos: push word ptr [IRom+2] {CAOS-ROMC}
jmp @@aus
@@basic: push word ptr [IRom+4] {HC-BASIC}
@@aus: push 0 ;{Start im Segment}
push 8 ;{Kilobytes}
push 1
call map
pop es
popa
@@1: pop ax
end;
(*
procedure IOWrite4; near; assembler;
asm cmp al,88h
jne @@w1
jmp IOW4_88
@@w1: cmp al,89h
jne @@w2
jmp IOW4_89
@@w2: cmp al,84h
jne @@w3
jmp IOW4_84
@@w3: cmp al,86h
jne @@w4
jmp IOW4_86
@@w4: end;
*)
procedure IOW13_2; near; assembler;
asm
and bl,$90 {1001 0000}
mov [Z1013Port2],bl
@@1: end;
procedure IOWrite13; near; assembler;
asm cmp al,2
jne @@w1
jmp IOW13_2
@@w1: {cmp al,3
jne @@w2
jmp IOW13_3
@@w2:} cmp al,8
jne @@w3
mov [Z1013Port8],bl
@@w3: end;
procedure DispatchIORead; near; assembler;
asm mov di,ax
and di,0FFh
shl di,1
jmp word ptr [PortsIn+di]
end;
procedure IOR80; near; assembler;
asm cmp ah,08h {keine "internen" Module schalten!}
jc @@e
push si
call FindKCModul
mov al,TMemNode[si].strukturbyte
pop si
jc @@e {kein Modul!}
ret
@@e: mov al,0FFh {kein Modul}
end;
procedure IORead4; near; assembler;
asm cmp al,80h
jne @@joj
jmp IOR80
@@joj: cmp al,88h
jnz @@w
mov al,[KC4Port88H]
ret
@@w: cmp al,89h
jnz @@w2
mov al,[KC4Port89H]
ret
@@w2: mov al,$ff
end;
const
KTAB: array[0..55] of char=
'1QAY2WSX3EDC4RFV5TGB6ZHN7UJM8IK,9OL.0P+/-@*^[]\_'+
#$17#$0D#$08#$09' '#$00#$0B#$0A;
procedure IORead13_2; near; assembler;
asm
mov bx,[Z1013Key]
and bl,bl
jz @@inf
mov al,[Z1013Port8]
cmp al,6
jnz @@sp6
test bh,2
jz @@sp6
test [Z1013Port2],10h
jnz @@sp6
mov al,$D
jmp @@in
@@sp6: cmp al,7
jnz @@spx
test [Z1013Port2],10h
jz @@inf
test bh,4
jz @@sp7
mov al,$B
jmp @@in
@@sp7: cmp bl,$16
jnz @@inf
mov al,7
jmp @@in
@@spx: shl al,3
test [Z1013Port2],10h
jz @@1
add al,4
@@1: xor ah,ah
push si
push cx
lea si,[KTAB]
add si,ax
xor cl,cl
@@2: lodsb
cmp al,bl
jz @@3
inc cl
cmp cl,4
jnz @@2
@@3: mov al,$FE
rol al,cl
and al,$F
pop cx
pop si
jmp @@in
@@inf: mov al,$F
@@in: or al,[Z1013Port2]{Tape-Bit noch setzen!!!}
end;
procedure IORead13; near; assembler;
asm cmp al,2
jnz @@w
jmp IORead13_2
@@w: mov al,$ff
end;
procedure CPUEmu; near; external;
procedure CallAX; near; external;
procedure DoNMI; near; external;
procedure DoINT; near; external; {Interrupt mit Vektor AL ausführen}
procedure DoReset; near; external; {Prozessor-Reset}
{$L KC880}
function KC3GetDividerCTC0:Word; near; assembler;
asm mov ax,56 {Doppelte Zeilenfrequenz bzgl. 1.75 MHz}
end;
function KC3GetDividerCTC2:Word; near; assembler;
asm mov ax,35000 {Bildfrequenz (50 Hz) bzgl. 1.75 MHz}
end;
function KC7GetDividerCTC3:Word; near; assembler;
asm mov ax,256*$96 {eigentlich: Zeitgeber-Ausgang von Kanal 2}
end;
procedure KC3SoundR; near; assembler;
{Sound-Ausgabe rechter Kanal; PE: DX:AX=Gesamtteiler}
asm cmp [WaveOption],3
jne @@ex {Keine Tonausgabe wenn nicht PC-Speaker}
pusha
push es
mov cx,ax
or cx,dx
jz @@stop
{Teiler_PC:=Teiler_KC*2/Frequenz_KC*Frequenz_PC}
add ax,ax
adc dx,dx
jnz @@stop {Teiler zu groß}
push ax
push 1193 {Taktfrequenz PC}
push [KCClock]
call MulDiv
push ax
cli
mov al,0B6h
out 43h,al
pop ax
out 42h,al
xchg ah,al
out 42h,al
sti
in al,61h
or al,3
out 61h,al
jmp @@e
@@stop:
in al,61h
and al,not 3
out 61h,al
@@e:
pop es
popa
@@ex:
end;
procedure KC3SoundL; near; assembler;
{Sound-Ausgabe linker Kanal; PE: DX:AX=Gesamtteiler}
{Zu beachten ist noch der angeschlossene Taktteiler am CTC-Ausgang!}
asm {call KC3SoundR}
end;
procedure CtcOut; near; external;
{Ausgabe-Aufruf mit AX=Portadresse, BL=Datenbyte, DI=LOW(Portadresse)*2}
procedure CtcIn; near; external;
{Eingabe-Aufruf mit AX=Portadresse, DI=LOW(Portadresse)*2, RET:AL=Datenbyte}
function Event_CTC(Msg,wParam:Word; lParam: LongInt):Word; near; external;
{$L KCCTC}
procedure InsertKC3CTC;
{Einfügen und "Anschließen" der CTC in der KC85-Serie}
var
io: PIoNode;
i: Integer;
begin
io:=Ptr(Seg(HInstance),MakeIoNode(ofs(Event_CTC),0));
io^.ctc[0].getp:=ofs(KC3GetDividerCTC0);
io^.ctc[1].getp:=ofs(KC3GetDividerCTC0);
io^.ctc[2].getp:=ofs(KC3GetDividerCTC2);
io^.ctc[3].getp:=ofs(KC3GetDividerCTC2);
io^.ctc[0].putp:=ofs(KC3SoundR);
io^.ctc[1].putp:=ofs(KC3SoundL);
for i:=0 to 3 do begin
PortsOut[$8C+i]:=ofs(CtcOut);
PortsIn[$8C+i]:=ofs(CtcIn);
PortsInstL[$8C+i]:=ofs(io^.ctc[i]);
end;
InsertIoNode(ofs(io^));
end;
procedure InsertKC7CTC;
{Einfügen und "Anschließen" der CTC in der KC87-Serie}
{IEI-IEO-Verkettung:
1. Steckkarten
2. PIO Tastatur
3. PIO User
4. CTC: typischer Robotron-Schwachsinn}
var
io: PIoNode;
i: Integer;
begin
io:=Ptr(Seg(HInstance),MakeIoNode(ofs(Event_CTC),3));
io^.ctc[3].getp:=ofs(KC7GetDividerCTC3); {die anderen sind unbeschaltet}
io^.ctc[0].putp:=ofs(KC3SoundR);
for i:=0 to 3 do begin
PortsOut[$80+i]:=ofs(CtcOut);
PortsIn[$80+i]:=ofs(CtcIn);
PortsInstL[$80+i]:=ofs(io^.ctc[i]);
end;
InsertIoNode(ofs(io^));
end;
{Die KC's müßten sich eigentlich strukturieren lassen!}
type
TKCInfo=record
memwrite: Word; {Speicherschreib-Prozedur}
ioread: Word;
iowrite: Word;
intchk: Word;
event: TCallEvent; {Langsame Prozeduren mit KCEV_xxx-Konstanten}
screen: TPoint; {(anfängliche) Bildschirmgröße in Pixeln}
color: Boolean;
freq: Word; {Nominelle Taktfrequenz}
rom: array[0..3] of Word; {Bis zu 4 intiale ROMs automatisch laden}
romaddr: array[0..3] of Word; {Initiale Einblendadressen}
DefPal: Word; {Offset zur Default-Palette}
end;
const
KCEV_Init=DRV_User+1; {lParam zeigt auf Hilfe-Datei}
KCEV_Done=DRV_User+2;
KCEV_KeyDown=DRV_User+3;
KCEV_KeyUp=DRV_User+4;
KCEV_Copy=DRV_User+5;
KCEV_PasteHint=DRV_User+6;
KCEV_Reset=DRV_User+7; {wParam=0: kalt, wParam=1: warm}
KCEV_Repaint=DRV_User+8;
KCEV_Load=DRV_User+9;
KCEV_Save=DRV_User+10;
KCEV_ReasCallHint=DRV_User+11;
{nach CALL zu bestimmten Adressen steht oft DB xx als UP-Nr., systemabh.}
KCEV_GetKeyword=DRV_User+12;
{Hilfe zu Schlüsselwort an Cursorposition (wParam=-1)
bzw. an Mausposition (wParam.lo=X, wParam.hi=Y, Cursor-Koordinaten)}
function LoadKCMem(src:Pointer; dst:Word; len:Word):Boolean; assembler;
{liefert FALSE, wenn sich nach dem Laden Bytes unterscheiden}
{!!später: Nicht vergessen, Breakpoints auf Speicherschreibzugriff totzulegen}
asm cld
les si,[src]
mov bx,[dst]
mov cx,[len]
mov ah,TRUE
jcxz @@e
@@l: seges lodsb
push es
mov es,[MemKCSel]
call [memwr]
cmp al,es:[bx] {gleich?}
je @@1
mov ah,FALSE
@@1: inc bx
pop es
loop @@l
@@e: xchg ah,al
end;
function ModulProc(Wnd:HWnd; Msg,wParam:Word; lParam:LongInt):Bool; export;
{nichtmodales Fenster zum Stecken und Ziehen von KC-Modulen}
var
S: array[byte] of Char;
I,K: Integer;
W: HWnd;
IA: array[0..34] of Integer; {Index-Array, wir haben 35 Module}
begin
ModulProc:=false;
case Msg of
WM_InitDialog: begin
W:=GetDlgItem(Wnd,104);
for I:=2048 to 2082 do begin
LoadString(Seg(HInstance),I,S,sizeof(S));
SendMessageP(W,LB_AddString,0,@S);
end;
ModulProc:=true;
end;
WM_Activate: if wParam<>0 then hKBWnd:=Wnd else hKBWnd:=0;
WM_EnterIdle: SendMessage(MainWnd,Msg,wParam,lParam);
{wird nur fürs Systemmenü gebraucht}
WM_Command: case wParam of
102: begin {Dazu}
W:=GetDlgItem(Wnd,104);
K:=SendMessageP(W,LB_GetSelItems,sizeof(IA) div 2,@IA);
for I:=0 to K-1 do begin
SendMessageP(W,LB_GetText,IA[I],@S);
SendDlgItemMsgP(Wnd,101,LB_AddString,0,@S);
end;
end;
103: begin {Weg}
W:=GetDlgItem(Wnd,101);
K:=SendMessageP(W,LB_GetSelItems,sizeof(IA) div 2,@IA);
for I:=0 to K-1 do begin
SendMessage(W,LB_DeleteString,IA[I],0);
end;
end;
ID_OK: ; {Module wirksam machen}
ID_Cancel: DestroyWindow(Wnd); {Wegtreten}
9: WinHelp(Wnd,HelpFile,HELP_Context,105);
end;
WM_Destroy: begin
hModul:=0;
end;
end;
end;
function KeySetProc(Wnd:HWnd; Msg,wParam:Word; lParam:LongInt):Bool; export;
{Modaler Dialog: Scancode setzen}
var
f: Integer;
begin
KeySetProc:=false;
case Msg of
WM_InitDialog: begin
SetDlgItemText(Wnd,100,PChar(lParam));
KeySetProc:=true;
end;
WM_Command: case wParam of
ID_OK,ID_Cancel: EndDialog(Wnd,1);
9: WinHelp(Wnd,HelpFile,HELP_Context,205);
end;
end;
end;
function KeymapProc(Wnd:HWnd; Msg,wParam:Word; lParam:LongInt):Bool; export;
{nichtmodales Fenster zum Festlegen der Tastaturzuordnung}
var
lPar: LongRec absolute lParam;
S: array[0..31] of Char;
I,K: Integer;
W: HWnd;
begin
KeymapProc:=false;
case Msg of
WM_InitDialog: begin
W:=GetWindow(Wnd,GW_Child); {Fensterliste durchgehen}
repeat
I:=GetDlgCtrlID(W)-100;
if (0<I) and (I<100) then begin {Scancode?}
if I>=70 then I:=I or $100; {Nicht den num. Block!}
if GetKeyNameText(MakeLong(0,I),S,sizeof(S)-1)>0 then begin
S[4]:=#0; {String begrenzen}
SetWindowText(W,S); {Neuer Schriftzug!}
end;
end;
W:=GetWindow(W,GW_HWndNext);
until W=0;
KeymapProc:=true;
end;
WM_Activate: if wParam<>0 then hKBWnd:=Wnd else hKBWnd:=0;
WM_EnterIdle: SendMessage(MainWnd,Msg,wParam,lParam);
{wird nur fürs Systemmenü gebraucht}
WM_Command: case wParam of
101..199: begin
I:=wParam-100;
if I>=70 then I:=I or $100; {Nicht den num. Block!}
if GetKeyNameText(MakeLong(0,I),S,sizeof(S)-1)<=0
then GetWindowText(lPar.Lo,S,sizeof(S));
DialogBoxParam(Seg(HInstance),MakeIntResource(205),Wnd,@KeySetProc,
LongInt(@S));
end;
ID_OK: ; {Tastatur wirksam machen}
ID_Cancel: DestroyWindow(Wnd); {Wegtreten}
9: WinHelp(Wnd,HelpFile,HELP_Context,204);
end;
WM_Destroy: hKeymap:=0;
end;
end;
function AboutProc(Wnd:HWnd; Msg,wParam:Word; lParam:LongInt):Bool; export;
const
RME: array[0..18]of Char='NOTEPAD README.TXT';
var
f: Integer;
begin
AboutProc:=false;
case Msg of
WM_InitDialog: AboutProc:=PostMessage(Wnd,WM_User+100,0,0);
WM_User+100: begin
f:=_lopen(RME+8,0);
if f<>-1 then begin
_lclose(f);
EnableWindow(GetDlgItem(Wnd,11),true);
end;
end;
WM_Command: case wParam of
ID_OK,ID_Cancel: EndDialog(Wnd,1);
11: WinExec(RME,SW_Show);
end;
end;
end;
procedure SetBlinken(NewBlinken:Boolean);
begin
if Blinken<>NewBlinken then begin
Blinken:=NewBlinken;
if (2<=KCTyp) and (KCTyp<=6) then begin
if Blinken
then SetTimer(MainWnd,1,400,nil)
else KillTimer(MainWnd,1);
end;
end;
end;
function GetTitleFirst:PChar;
begin
GetTitleFirst:=AppName;
if (EmuShowClock and 8 <>0) and (KCTyp<>0)
then GetTitleFirst:=KCName;
end;
procedure ShowFreq;
var
vsrec: record
sp: PChar;
over: PChar;
hz: LongInt; {bestehend aus Zahl und Rest}
end;
S: array[0..63] of Char;
begin
vsrec.sp:=GetTitleFirst;
vsrec.over:='>';
if Freq<>$FFFF then Inc(vsrec.over); {Kein ">" anzeigen}
if EmuShowClock and 3 >1 then begin
vsrec.hz:=LongDivWR(Freq,1000);
wvsprintf(S,'%s - %s%u.%03u MHz',vsrec);
end else begin
vsrec.hz:=LongDivWR(MulDivW(Freq,1000,KCClock),10);
{!! Gefahrenstelle (/0 ERROR) wenn KCClock<1000}
wvsprintf(S,'%s - %s%u.%u %%',vsrec);
end;
SetWindowText(MainWnd,S);
end;
procedure SetFreq(NewFreq:Word); {Freq in Kilohertz}
{Wird niemals gerufen, wenn EmuBlock<>0}
begin
if Freq<>NewFreq then begin
Freq:=NewFreq;
if (EmuShowClock and 3 =0)
or (EmuShowClock and 4 =0) and IsIconic(MainWnd)
then exit; {nichts tun!}
ShowFreq;
end;
end;
procedure ShowBlocked; {Anzeige "KC-Emulator (Angehalten)"}
var
vsrec: record
s1,s2: PChar;
end;
S: array[0..63] of Char;
S1: array[0..16] of Char;
begin
vsrec.s1:=GetTitleFirst;
LoadString(Seg(HInstance),107,S1,sizeof(S1));
vsrec.s2:=S1;
wvsprintf(S,'%s (%s)',vsrec);
SetWindowText(MainWnd,S);
end;
procedure DrawTitle; {Neuzeichnen des Titels}
begin
if (EmuShowClock and 3 =0)
or (EmuShowClock and 4 =0) and IsIconic(MainWnd) and (EmuBlock=0)
then SetWindowText(MainWnd,GetTitleFirst)
else if EmuBlock<>0 then ShowBlocked else ShowFreq;
end;
procedure SetBlock(NewBlock:Byte); {<>0 wenn Blockierung}
begin
if EmuBlock<>NewBlock then begin
if EmuShowClock and 3 <>0 then begin {sonst nichts an Titelzeile tun!}
if (EmuBlock=0) and (NewBlock<>0) then ShowBlocked;
if (EmuBlock<>0) and (NewBlock=0) then begin
ShowFreq; {Frequenz wieder anzeigen}
TickTaken:=cTicks;
TimeTaken:=Word(GetTickCount); {Neue Messung}
end;
end;
CheckMenuItem(GetMenu(MainWnd),230,
Bool2MenuCheck(Bool(NewBlock and $10)) or MF_ByCommand);
EmuBlock:=NewBlock;
end;
end;
procedure SetShowClock(NewShowClock:Integer);
begin
if EmuShowClock<>NewShowClock then begin
EmuShowClock:=NewShowClock;
DrawTitle;
end;
end;
procedure SetMenuFlags(NewMenuFlags:Integer);
var
M: HMenu;
I,Mask: Word;
begin
M:=GetMenu(MainWnd);
Mask:=1;
for I:=201 to 203 do begin
if (NewMenuFlags xor MenuFlags) and Mask <>0 then begin
MenuFlags:=MenuFlags xor Mask;
CheckMenuItem(M,I,Bool2MenuCheck(Bool(MenuFlags and Mask)));
end;
end;
end;
function GetWindowArgs(Wnd: HWnd):Boolean;
{liefert TRUE, wenn alle Argumente okay oder auch leere Zeichenkette.
PA: LoadSaveArgs gefüllt
Args.argn enthält die gewandelte Argumente-Zahl, auch bei Rückkehr mit FALSE}
var
S: array[0..31] of Char;
SP,SP1,SP2: PChar;
EC: Integer;
begin
GetWindowArgs:=false;
SP:=S+1;
GetWindowText(Wnd,SP,sizeof(S)-1);
LoadSaveArgs.argn:=0;
while (LoadSaveArgs.argn<3)
and (SP^<>#0) do begin
SP1:=lStrChr(SP,' ');
if SP1<>nil then SP1^:=#0; {am Leerzeichen terminieren}
if SP^='#' then SP2:=SP+1 {Dezimal-Kennung}
else begin
SP2:=SP-1;
SP2^:='$'; {Präfix für Hex-VAL}
end;
Val(SP2,LoadSaveArgs.arg[LoadSaveArgs.argn+1],EC);
if EC<>0 then exit; {Fehler!}
if SP1<>nil then SP:=SP1+1 else SP^:=#0;
Inc(LoadSaveArgs.argn);
end;
GetWindowArgs:=true;
end;
procedure SetWindowArgs(Wnd: HWnd);
{setzt bis zu 3 hexadezimale Argumente, mit je 1 Leerzeichen getrennt
PE: LoadSaveArgs: Argumente}
var
S: array[0..31] of Char;
I: Integer;
Z: Integer;
begin
Z:=0; {Zeichenzahl}
for I:=1 to LoadSaveArgs.argn do begin
Inc(Z,wvsprintf(S+Z,'%04X',LoadSaveArgs.arg[I]));
if I<>LoadSaveArgs.argn then begin
S[Z]:=' '; Inc(Z);
end;
end;
S[Z]:=#0;
SetWindowText(Wnd,S);
end;
function GetFileArgs(f,Typ: Integer):Boolean;
{Typ ist hierbei bitteschön niemals 0!
Liefert in LoadSaveArgs die "Argumente" der Datei
f ist eine frisch zum Lesen geöffnete Datei, Dateizeiger=0!
liefert FALSE wenn keine gültige .KCC-Datei, zu große Binärdatei oder
ungültiges BASIC-Programm. Bei FALSE ist LoadSaveArgs.argn undefiniert!}
var
Z80Hdr: TZ80Hdr;
KccHdr: TKccHdr absolute Z80Hdr;
L: LongInt;
begin
GetFileArgs:=false;
case Typ of
1: begin
_lread(f,PChar(@KCCHdr),sizeof(KCCHdr));
if (KccHdr.args.argn<2) or (KccHdr.args.argn>10) then exit;
_llseek(f,$80,0);
Move(KccHdr.args,LoadSaveArgs,sizeof(LoadSaveArgs));
if LoadSaveArgs.argn>3 then LoadSaveArgs.argn:=3;
end;
2: begin
L:=_llseek(f,0,2);
if L>$BE00 then exit; {SOO große Programme gibt's ja gar nicht!}
_llseek(f,0,0);
LoadSaveArgs.argn:=2;
LoadSaveArgs.arg[1]:=$200; {mal angenommen}
LoadSaveArgs.arg[2]:=LoadSaveArgs.arg[1]+LongRec(L).Lo;
end;
3: begin
LoadSaveArgs.argn:=2;
LoadSaveArgs.arg[1]:=$401; {Anfang für ROM-BASIC}
_lread(f,PChar(@LoadSaveArgs.arg[2]),2);{Zeiger jetzt richtig}
if LoadSaveArgs.arg[2]>$BB00 then exit; {BASIC-Programm zu groß}
Inc(LoadSaveArgs.arg[2],LoadSaveArgs.arg[1]);
end;
4: begin
_lread(f,PChar(@Z80Hdr),sizeof(Z80Hdr));
if (Z80Hdr.magic[0]<>Z80Hdr.magic[1])
or (Z80Hdr.magic[0]<>Z80Hdr.magic[2]) then exit;
if (Z80Hdr.magic[0]<>#$d3) and (Z80Hdr.magic[0]<>'.') then exit;
LoadSaveArgs.argn:=2;
if Z80Hdr.typ='C' then LoadSaveArgs.argn:=3;
LoadSaveArgs.arg:=Z80Hdr.arg;
end;
end;
GetFileArgs:=true;
end;
const
ID_OfnFileEdit=1152;
ID_OfnFileList=1120;
ID_OfnFilter=1136;
ID_OfnComment=100;
ID_OfnHelp=1038;
ID_OfnWriteProt=1040;
var
WM_FileOK: Word;
var
SFile: array[0..255] of Char;
SFilter: array[0..255] of Char;
SExt: array[0..15] of Char;
function OFNHook(Wnd:HWnd; Msg,wParam:Word; lParam:Longint):Word;
export; forward;
const
Ofn: TOpenFileName=(
lStructSize: sizeof(TOpenFileName);
hWndOwner: 0;
hInstance: Seg(HInstance);
lpstrFilter: SFilter;
lpstrCustomFilter: SExt;
nMaxCustFilter: sizeof(SExt);
nFilterIndex: 0;
lpstrFile: SFile;
nMaxFile: sizeof(SFile);
lpstrFileTitle: nil;
nMaxFileTitle: 0;
lpstrInitialDir: nil;
lpstrTitle: nil;
Flags: OFN_LongNames or OFN_FileMustExist or OFN_ShowHelp
or OFN_EnableHook or OFN_OverwritePrompt;
nFileOffset: 0;
nFileExtension: 0;
lpstrDefExt: nil;
lCustData: 0;
lpfnHook: OfnHook;
lpTemplateName: nil);
function OFNHook(Wnd:HWnd; Msg,wParam:Word; lParam:Longint):Word;
{Diese Hook-Funktion verlängert die Datei-Öffnen-Standarddialoge um eine
Zeile für Anfangs-, End- und (ggf) Startadresse.
LoadSaveArgs enthält die Daten des Zusatzfensters.
lCustData zeigt auf TArgs-Struktur.}
label err;
var
lPar: LongRec absolute lParam;
S: array[0..31]of Char; {Dateiname sowie Lade-Strings}
f: Integer;
R: TRect;
P: TPoint;
Fnt: HFont;
W: HWnd absolute P;
ofnp: POpenFileName absolute lParam;
begin
OFNHook:=0;
case Msg of
WM_InitDialog: begin
WM_FileOK:=RegisterWindowMessage(FileOKString);
Longint(P):=GetDialogBaseUnits;
GetClientRect(Wnd,R); {Neue Dialogelemente an die Unterkante}
LoadString(Seg(HInstance),104,S,sizeof(S));
SetDlgItemText(Wnd,ID_OfnWriteProt,S);
LoadString(Seg(HInstance),103,S,sizeof(S));
Fnt:=SendMessage(Wnd,WM_GetFont,0,0);
SendMessage(CreateWindow('STATIC',S,
WS_Child or WS_Visible or SS_Left or WS_Group,
MulDiv(P.X,6,4),R.bottom,MulDiv(P.X,34,4),MulDiv(P.Y,8,8),
Wnd,Word(-1),Seg(HInstance),nil),WM_SetFont,Fnt,0);
SendMessage(CreateWindow('EDIT','',
WS_Child or WS_Visible or WS_Border or WS_TabStop
or ES_Left or ES_AutoHScroll {or ES_ReadOnly},
MulDiv(P.X,40,4),R.bottom+MulDiv(P.Y,-2,8),
R.right+MulDiv(P.X,-46,4),MulDiv(P.Y,10,8),
Wnd,ID_OfnComment,Seg(HInstance),nil),WM_SetFont,Fnt,0);
GetWindowRect(Wnd,R); {Fenster vergrößern}
MoveWindow(Wnd,R.left,R.top,R.right-R.left,
R.bottom-R.top+MulDiv(P.Y,14,8),false);
OfnHook:=1;
end;
WM_Command: case wParam of
{ID_OfnFilter unnötig, Dateiliste wird ohnehin neu aufgebaut}
ID_OfnFileList: if lPar.Hi=LBN_SelChange then begin
ofn.nFilterIndex:=SendDlgItemMessage(Wnd,ID_OfnFilter,CB_GetCurSel,0,0)+1;
R.left:=SendMessage(lPar.Lo,LB_GetCurSel,0,0);
W:=GetDlgItem(Wnd,ID_OfnComment);
SetWindowText(W,'?');
if R.left<0 then exit; {mit Fragezeichen stehenlassen}
SendMessageP(lPar.Lo,LB_GetText,R.left,@S);
f:=_lopen(S,0);
if f=-1 then exit;
if GetFileArgs(f,ofn.nFilterIndex)
then SetWindowArgs(W);
_lclose(f);
end;
ID_OfnHelp: WinHelp(Wnd,HelpFile,HELP_Context,102);
end{case wParam};
else if Msg=WM_FileOK then begin
W:=GetDlgItem(Wnd,ID_OfnComment);
if not GetWindowArgs(W) then goto err;
if LongRec(ofnp^.flags).lo and OFN_HideReadOnly <>0 {SAVE}
then case ofnp^.nFilterIndex of
1,2: if LoadSaveArgs.argn<2 then goto err;
end else case ofnp^.nFilterIndex of {LOAD}
1: if LoadSaveArgs.argn<2 then goto err;
2: if LoadSaveArgs.argn<1 then goto err;
end;
exit;
err:
MBox1(Wnd,106,nil);
SetFocus(W);
SendMessage(W,EM_SetSel,0,$FFFF0000);
OfnHook:=1; {Nicht weiterarbeiten!}
end;
end{case Msg};
end;
function lstrcmpin2(LongS,ShortS:PChar):Integer;
{Ist ShortS der Anfang von LongS?}
var
c: Char;
SP: PChar;
begin
SP:=LongS+lstrlen(ShortS);
c:=SP^;
SP^:=#0;
lstrcmpin2:=lstrcmpi(LongS,ShortS);
SP^:=c;
end;
function FindExtensionInFilter:PChar;
var
I: Integer;
SP1: PChar;
begin
SP1:=SFilter;
for I:=Integer(Ofn.nFilterIndex)*2 downto 2 {min. 1x}
do Inc(SP1,lstrlen(SP1)+1);
FindExtensionInFilter:=SP1;
end;
procedure PrepareOFN;
var
SP1,SP2:PChar;
I: Integer;
begin
Ofn.hWndOwner:=MainWnd;
LoadString(Seg(HInstance),102,SFilter,sizeof(SFilter));
if Integer(Ofn.nFilterIndex)<>0 then begin
SP1:=FindExtensionInFilter;
{Bug der COMMDLG.DLL bereinigen (welcher war das?)}
if lstrcmpin2(SP1,SExt+1)<>0 then begin
SP2:=SP1+lstrlen(SP1); {String-Ende}
memmove(SP1+lstrlen(SExt+1),SP2,SFilter+sizeof(SFilter)-SP2);
lstrcpy(SP1,SExt+1); {User-Extension einfügen}
end;
end;
SFile[0]:=#0;
ofn.lpstrDefExt:=nil;
end;
function ScanInt(var SP: PChar; var I:Integer):Boolean;
var
SP1: PChar;
K,EC: Integer;
begin
ScanInt:=false;
SP1:=lStrChr(SP,' ');
if SP1<>nil then SP1^:=#0;
Val(SP,K,EC);
if EC=0 then begin
if SP1<>nil then SP:=SP1+1 else Inc(SP,lstrlen(SP));
I:=K;
ScanInt:=true;
end;
end;
function ScanFreq(SP: PChar; F:PWord):Boolean;
{Was, wenn ich keine Gleitkommazahlen WILL!?}
var
SP1: PChar;
K,L,M: Word;
EC: Integer;
begin
ScanFreq:=false;
SP1:=lStrChr(SP,'.');
if SP1=nil then SP1:=lStrChr(SP,','); {auch ein Komma ist hier zulässig}
if SP1<>nil then SP1^:=#0;
Val(SP,K,EC); {Vorkommastellen}
if EC<>0 then exit;
if K>8 then exit; {mehr als 8MHz sind utopisch!}
M:=1000;
K:=K*M;
L:=0;
if SP1<>nil then begin
Inc(SP1);
Val(SP1,L,EC);
if EC<>0 then exit;
while SP1^<>#0 do begin
M:=M div 10;
if M=0 then exit;
Inc(SP1);
end;
K:=K+L*M;
end;
if F<>nil then F^:=K; {keine Zuweisung, nur Test bei NIL}
ScanFreq:=true; {alles okay}
end;
procedure ApplyColorTable;
var
C: array[0..31] of TRGBQuad;
I: Integer;
begin
for I:=0 to 31 do with C[I],TPaletteEntry(Palette.col[I]) do begin
rgbBlue:=peBlue; {einzelbyteweise, weil verdreht!}
rgbGreen:=peGreen;
rgbRed:=peRed;
rgbReserved:=peFlags;
end;
WinGSetDibColorTable(WinGDC,0,32,PRGBQuad(@C));
end;
procedure ClearDisplayBuffer;
{gibt den hDisplay-Puffer frei und ggf. die zugehörige WinG-Pixmap}
begin
if hDisplay<>0 then begin
if UseWinG and (WinGBM<>0) then begin
DeleteObject(SelectObject(WinGDC,WinGBMMono));
WinGBM:=0;
hDisplay:=0;
end else hDisplay:=GlobalFree(hDisplay);
end;
end;
function SetWinGUse(NewUse:Boolean):Boolean;
{diese Funktion erlaubt sogar das Ein- und Ausschalten von WinG
während der Emulation, indem ggf. der Bildspeicher umgeschaufelt wird}
const
LibName='WING.DLL';
SecName='WinG';
KeyName='ProfileMessage';
var
S: array[0..255] of Char;
OldErrorMode: Word absolute S;
hMem: THandle absolute OldErrorMode;
P: Pointer absolute S;
begin
SetWinGUse:=true;
if NewUse<>UseWinG then begin
if NewUse then begin
LoadString(Seg(HInstance),109,S,sizeof(S));
WriteProfileString(SecName,KeyName,S); {eine deutsche Meldung geben}
OldErrorMode:=SetErrorMode(SEM_NoOpenFileErrorBox);
WinGInst:=LoadLibrary(LibName); {das Laden führt ggf. zum Profiling}
SetErrorMode(OldErrorMode);
WriteProfileString(SecName,KeyName,nil); {wieder löschen!}
if WinGInst>=32 then begin
TFarProc(@WinGCreateDC):= GetProcAddress(WinGInst,PChar(1001));
TFarProc(@WinGCreateBitmap):= GetProcAddress(WinGInst,PChar(1003));
TFarProc(@WinGSetDibColorTable):= GetProcAddress(WinGInst,PChar(1006));
TFarProc(@WinGStretchBlt):= GetProcAddress(WinGInst,PChar(1009));
TFarProc(@WinGBitBlt):= GetProcAddress(WinGInst,PChar(1010));
WinGDC:=WinGCreateDC;
if hDisplay<>0 then begin
WinGBM:=WinGCreateBitmap(WinGDC,KCPixmap.bi,@P);
if WinGBM<>0 then begin
if PtrRec(P).Ofs <>0 then RunError(222);
hmemcpy(P,Ptr(hDisplay,0),DisplaySize); {umschaufeln}
GlobalFree(hDisplay);
hDisplay:=PtrRec(P).Sel;
WinGBMMono:=SelectObject(WinGDC,WinGBM);
ApplyColorTable;
end;
end;
UseWinG:=true;
end else begin
MBox1(MainWnd,110,LibName); {später: Verzweigung?}
SetWinGUse:=false; {einziger Fall des Versagens}
end;
end else begin
if WinGBM<>0 then begin {momentan Bitmap in Verwendung?}
hMem:=GlobalAlloc(GMEM_Fixed,DisplaySize);
if hMem=0 then RunError(220); {Hoppla!?}
hmemcpy(Ptr(hMem,0),Ptr(hDisplay,0),DisplaySize);
ClearDisplayBuffer; {UseWinG ist noch TRUE!}
hDisplay:=hMem;
end;
DeleteDC(WinGDC);
FreeLibrary(WinGInst);
UseWinG:=false;
end;
end;
end;
procedure SetNewPixmap(x,y:Integer; Bunt:Boolean);
{x darf nicht 0 sein, sonst würde das Fenster zu schmal gesetzt werden.
y dagegen darf 0 sein und stellt den Client-Bereich auf Höhe Null}
var
WP: TWindowPlacement;
NewDisplay: Boolean absolute WP;
I: Integer absolute WP;
P: Pointer absolute WP;
begin
NewDisplay:=hDisplay=0; {neues Display auf jeden Fall wenn Null}
if (KCPixmap.x<>x) or (KCPixmap.y<>y) then begin
KCPixmap.x:=x;
KCPixmap.y:=y; {Neue Dimensionen eintragen}
if y<>0 then begin {Nullclient sieht erst mal doof aus!}
wp.length:=sizeof(wp);
if GetWindowPlacement(MainWnd,@WP)
then with WP,WP.rcNormalPosition do begin
right:=left+x+Saum.x;
bottom:=top+y+Saum.y;
SetWindowPlacement(MainWnd,@WP); {Fenster umsetzen}
if IsZoomed(MainWnd) then MoveWindow(MainWnd,
ptMaxPosition.x,ptMaxPosition.y,x*2+Saum.x,y*2+Saum.y,true);
end; {Extrawurst für maximiertes Fenster}
end;
NewDisplay:=true;
end;
if bunt and (KCPixmap.b=1) then begin
KCPixmap.b:=8;
KCPixmap.c:=32;
NewDisplay:=true;
end;
if not bunt and (KCPixmap.b<>1) then begin
KCPixmap.b:=1;
KCPixmap.c:=2;
NewDisplay:=true;
end;
if NewDisplay then begin
ClearDisplayBuffer; {alles aufräumen}
if not bunt then x:=x shr 3; {S/W: 1 Byte für 8 Pixel!}
if y<>0 then begin
DisplaySize:=LongMul(x+3 and not 3,y);{Auf /4 teilbare Bytezahl aufrunden}
if UseWinG then begin
WinGBM:=WinGCreateBitmap(WinGDC,KCPixmap.bi,@P);
if WinGBM<>0 then begin {ist 0 z.B. bei Win31 und S/W-Bitmap}
WinGBMMono:=SelectObject(WinGDC,WinGBM);
ApplyColorTable;
hDisplay:=PtrRec(P).Sel;
if PtrRec(P).Ofs<>0 then RunError(222); {Oops?}
end;
end;
if hDisplay=0 then hDisplay:=GlobalAlloc(GMEM_Fixed,DisplaySize);
if hDisplay=0 then RunError(220);
end;
InvalWnd;
end;
end;
procedure PokeKC3Char(C:Char); assembler;
asm mov es,[MemKCSel]
mov al,[C]
mov bx,[Regs.IX]
add bx,0dh
call [MemWR]
add bx,8-0dh
mov al,es:[bx]
or al,1
call [MemWR] {Keycode-Avail-Bit setzen}
jmp @@e
@@e: end;
procedure KeyUpKC3; assembler;
asm mov es,[MemKCSel]
mov bx,[Regs.IX]
add bx,0dh
mov al,0
call [MemWR]
{Tastencode löschen, Keycode-Avail-Bit bleibt stehen!}
end;
procedure InsertROMs; {geladene ROMs (wieder) einblenden}
var
I: Integer;
begin
for I:=0 to 3 do if (IRom[I]<>0) and (IRomAddr[I]<>0)
then Move(Mem[IRom[I]:0],Mem[MemKCSel:IRomAddr[I]],GlobalSize(IRom[I]));
end;
function LoadROM(ID:Word):THandle;
var
h: THandle;
begin
h:=LoadResource(Seg(HInstance),
FindResource(Seg(HInstance),MakeIntResource(ID),RT_RCData));
if h=0 then RunError(220);
LoadROM:=h;
end;
function MakeNode1(seg,stse,sust,proc,siz,block:Word):Word; assembler;
asm push TYPE TMemNode-12 {nur ein seg}
call LocalAllocW
push ax
xchg di,ax
push ds
pop es
xor ax,ax
cld
stosw {.next löschen}
lea si,block
mov cx,6 {alle Argumente einkopieren}
segss
rep movsw
stosw {seg[0].r löschen}
pop ax
end;
{TMemNode sollte außerdem enthalten:
extra Byte für Handle-Typ
extra Byte für Ein/Aus und Schreibschutz
neues Word für Create/Info/Destroy-Prozedur}
procedure BroadcastIoEvent(Msg:Byte); assembler;
asm mov di,offset IOChain
@@l: mov di,[di]
or di,di
jz @@e
mov ah,[Msg]
mov al,0FFh
push di
call MakeRepIoNodeCall
pop di
jmp @@l
@@e:
end;
type
TConvFunc=function(Code:Char):Char;
function KC2Ansi(Code:Char):Char; far;
begin
Byte(code):=Byte(code) and $7F;
case Byte(code) of
$00: KC2Ansi:=' ';
$5B: KC2Ansi:=#$80; {Vollcursor}
$5C: KC2Ansi:='|';
$5D: KC2Ansi:=#$AC; {Negation}
$60: KC2Ansi:=#$A9; {Copyright}
$7B: KC2Ansi:=#$E4; {ä}
$7C: KC2Ansi:=#$F6; {ö}
$7D: KC2Ansi:=#$FC; {ü}
$7E: KC2Ansi:=#$DF; {ß}
else KC2Ansi:=code;
end;
end;
function NoConversion(Code:Char):Char; far;
begin
NoConversion:=Code;
end;
function GetScreenText(scr_x,scr_y:Integer; scr_a:PChar; Convert:TConvFunc):
THandle;
{verwendet SelectedRegion, SelectedRect, RandL, RandR}
var
SP: PChar;
HMem: THandle;
x,y,siz: Integer;
R: TRect;
begin
CopyRect(R,SelectedRect);
if SelectedRegion=0 then SetRect(R,0,0,scr_x,scr_y);
if RandL or RandR =0 then siz:=(R.right-R.left+2)*(R.bottom-R.top+1)+1
else siz:=(scr_x+2)*scr_y; {noch unsicher!}
HMem:=GlobalAlloc(GMEM_Share,siz);
SP:=GlobalLock(HMem);
for y:=R.top to R.bottom do begin
for x:=R.left to R.right-1 do begin
SP^:=Convert(scr_a[y*scr_x+x]);
Inc(SP);
end;
SP^:=#13; Inc(SP); SP^:=#10; Inc(SP);
end;
SP^:=#0;
GlobalUnlock(HMem);
GetScreenText:=HMem;
end;
procedure IsCAN; assembler;
{PE: AL=Zeichencode, PA: Z=1 wenn nicht alphanumerisch}
asm pusha
push es
push ax
call IsCharAlphaNumeric
or ax,ax
pop es
popa
end;
procedure IsCA; assembler;
{PE: AL=Zeichencode, PA: Z=1 wenn kein Buchstabe}
asm pusha
push es
push ax
call IsCharAlpha
or ax,ax
pop es
popa
end;
procedure KC3_CharAtDX; assembler;
{PE: DX=Cursorpos in Bildschirm-Koordinaten,
ES:DI=Video-RAM-Basisadresse
PA: SI=Video-RAM-Adresse
AL=Zeichencode
VR: AL,SI}
asm push ax
mov al,40
mul dh
add al,dl
adc ah,0
add ax,di
xchg si,ax
pop ax
mov al,es:[si]
end;
procedure KC3_PreloadBXCXDX; assembler;
{PE: DX=absolute Position oder -1
PA: CY=1: Fehler (außerhalb BS)}
asm mov cx,es:[0B79Ch] {Fenster-Anfang}
mov bx,es:[0B79Eh] {Fenster-Länge}
add bl,cl
add bh,ch {2x Fenster-Ende}
cmp dx,-1 {DX schon vorgegeben?}
jne @@dx_ok
mov dx,es:[0B7A0h]
add dx,cx {in Absolutkoordinate umwandlen}
@@dx_ok:
cmp dl,40
jnc @@inval
cmp dh,32
jnc @@inval
cmp dl,cl
jc @@out
cmp dl,bl
jnc @@out
cmp dh,ch
jc @@out
cmp dh,bh
jc @@no_out
@@out:
mov cx,0 {BS-Anfang}
mov bx,32*256+40 {BS-Ende}
@@no_out:
stc
@@inval:
cmc
end;
procedure KC3_MoveCursor; assembler;
{PE: BX=Fenster-Ende,
CX=Fenster-Anfang,
DX=Cursorpos in Bildschirm-Koordinaten,
ES=[MemKCSel],
CY=1: Laufrichtung rückwärts
PA: DX=neue Cursorposition
CY=1: Kann nicht mehr (DX unverändert)
VR: BX,CX
N: Ist DX innerhalb eines Fensters, bezieht sich der Bewegungsrahmen
auf das eingestellte Fenster, sonst auf den Bildschirm.
Routine ist allgemein anwendbar!}
asm push dx
jc @@back
inc dl {nächste Spalte}
cmp dl,bl {Rechts raus?}
js @@ok {nein}
mov dl,cl {links!}
inc dh {Nächste Zeile}
cmp dh,bh {Unten raus?}
js @@ok
jmp @@err
@@back:
dec dl
cmp dl,cl {Links raus?}
jns @@ok {nein}
mov dl,bl
dec dl {doch, rechts!}
dec dh
cmp dh,ch {Oben raus?}
jns @@ok
@@err: pop dx
stc
ret
@@ok: add sp,2
clc
end;
procedure Def_KCM_Event(Msg,wParam:Word; lParam:LongInt);
{verarbeitet gleiche Ereignisse auf allen Mühlhausen-Rechnern}
begin
case Msg of
KCEV_Init: begin
GetAnimIdx:=Ofs(GetAnimIdx3);
lstrcpy(PChar(lParam),'KCCAOS');
end;
KCEV_Reset: case wParam of
0: Regs.pc:=$F000; {Reset-Startpunkt}
1: Regs.pc:=$E000; {PowerOn-Startpunkt}
end;
KCEV_KeyDown: PokeKC3Char(Char(wParam));
KCEV_KeyUp: KeyUpKC3;
KCEV_PasteHint: asm {lParam=Zeiger auf Bool}
mov es,[MemKCSel]
mov bx,[Regs.IX]
xor ax,ax
test es:byte ptr es:[bx+8],1 {Keycode-Avail-Bit testen}
jnz @@1
inc ax
@@1: les bx,[lParam]
mov es:[bx],ax
end;
KCEV_GetKeyword: asm {!! bevorzugt Markierung als Schlüsselwort}
mov es,[MemKCSel]
mov dx,[wParam]
call KC3_PreloadBXCXDX
mov di,0B200h {Anfang IRM}
cmp [KCTyp],4
je @@4extra
cmp [KCTyp],5
jne @@no4extra
@@4extra:
mov di,es:[0B7CBh] {hier gibt es einen Zeiger!}
@@no4extra:
call KC3_CharAtDX
call IsCAN
jnz @@ok1
stc
call KC3_MoveCursor {Zurück}
jc @@inval
call KC3_CharAtDX
call IsCAN
jz @@inval
@@ok1: {hier könnte ein Schlüsselwort sein; Anfang suchen!}
mov ah,8 {max. 8 Zeichen zurückgehen}
@@scanstart:
stc
call KC3_MoveCursor
jc @@scanstop
call KC3_CharAtDX
call IsCAN
jz @@scanstop1
dec ah
jnz @@scanstart
jmp @@inval {kein Anfang gefunden!}
@@scanstop1:
mov ah,8 {Suchen nach erstem Buchstaben}
@@scanr1:
clc
call KC3_MoveCursor {nach rechts}
jc @@inval {rechts raus: Fehler!}
jmp @@v1
@@scanstop:
mov ah,8 {Suchen nach erstem Buchstaben}
@@v1:
call KC3_CharAtDX
call IsCA
jnz @@startKeyword
dec ah
jnz @@scanr1
jmp @@inval {kein Buchstabe gefunden, nur Zahlen}
@@startKeyword:
mov ah,8 {max. 8 Zeichen}
@@l: push es
les si,[lParam]
mov es:[si],al
inc LongRec[lParam].lo
pop es
clc
call KC3_MoveCursor {weiter rechts}
jc @@terminate
call KC3_CharAtDX
call IsCAN {Alphanumerisch?}
jz @@terminate
dec ah
jnz @@l
@@terminate:
les si,[lParam]
mov byte ptr es:[si],0
@@inval:
end;
end;
end;
procedure Def_Z_Event(Msg,wParam:Word; lParam:LongInt);
{für Gemeinsamkeiten bei Z9001/KC87}
begin
case Msg of
KCEV_Init: begin
KC4Port88H:=0; {damit die Zuordnung zum initialen Videomodus stimmt}
lstrcpy(PChar(lParam),'KCZ9001');
PortsOut[$88]:=ofs(IOWZ88);
InsertKC7CTC;
end;
KCEV_Reset: Regs.pc:=$F000; {PowerOn- und Reset-Startpunkt}
KCEV_Done: begin
BroadcastIoEvent(IOEV_Destroy);
ClearIoNodes;
end;
KCEV_KeyDown: asm
mov es,[MemKCSel]
mov al,byte ptr [wParam]
mov bx,24h
call [memwr]
inc bx
call [memwr]
end;
KCEV_KeyUp: asm
mov es,[MemKCSel]
mov al,0
mov bx,24h
call [memwr]
end;
KCEV_Copy: begin
wParam:=24; if KC4Port88H and 4 <>0 then wParam:=20;
SetClipboardData(CF_Text,
GetScreenText(40,wParam,Ptr(MemKCSel,$EC00),NoConversion));
end;
KCEV_PasteHint: asm {lParam=Zeiger auf Bool}
mov es,[MemKCSel]
xor ax,ax
cmp es:byte ptr [25h],1 {CY=1: OK für Paste}
adc ax,ax
les bx,[lParam]
mov es:[bx],ax
end;
end;
end;
function Event1(Msg,wParam:Word; lParam:LongInt):LongInt; far;
begin
Def_Z_Event(Msg,wParam,lParam);
Event1:=0;
case Msg of
KCEV_Init: ;
KCEV_Repaint: IRM_Update1;
KCEV_Done: ;
end;
end;
function Event7(Msg,wParam:Word; lParam:LongInt):LongInt; far;
begin
Def_Z_Event(Msg,wParam,lParam);
case Msg of
KCEV_Init: begin
GetAnimIdx:=Ofs(GetAnimIdx7);
SetBorder(0);
end;
KCEV_Repaint: IRM_Update7;
KCEV_Done: begin
SetBorder(-1);
end;
end;
end;
(*
function Event2(Msg,wParam:Word; lParam:LongInt):LongInt; far;
begin
Def_KCM_Event(Msg,wParam,lParam);
case Msg of
KCEV_Repaint: IRM_Update3;
end;
end;
function MakeNode(steckplatz:Byte;flags:Byte; start,endi:ShortInt;
SwitchProc:Word; Strukturbyte:Byte; P:THandle):Word;
var
N: PMemNode;
begin
N:=Ptr(Seg(Hinstance),LocalAlloc(LPTR,sizeof(TMemNode)));
if PtrRec(N).Ofs=0 then RunError(221);
N^.steckplatz:=steckplatz;
N^.steuerbyte:=flags;
N^.size:=endi-start+1; {Notlösung!}
N^.switchproc:=SwitchProc;
N^.strukturbyte:=Strukturbyte;
N^.memblock:=P;
N^.segments:=1;
N^.seg[0].a:=start;
N^.seg[0].e:=endi;
MakeNode:=PtrRec(N).Ofs;
end;
*)
function Event3(Msg,wParam:Word; lParam:LongInt):LongInt; far;
begin
Def_KCM_Event(Msg,wParam,lParam);
case Msg of
KCEV_Init: begin
KC4Port88H:=$FF;
{ asm int 3 end;}
FillK(MemKCSel,0,64); {alles $FF}
SetWrPerm(0,63,false); {alles ist schreibgeschützt}
NodeRam0:=MakeNode1($0F00,$0100,$03FF,0,16,0); {ein, schreibbar}
InsertKCModul(NodeRam0);
NodeIRM:= MakeNode1($2F20,$0101,$03FF,0,16,0);
InsertKCModul(NodeIRM);
if KCTyp<>2 then begin
NodeBasic:=MakeNode1($3730,$1102,$01FF,0,8,6);
InsertKCModul(NodeBasic); IRom[1]:=0; {ROM in Eigenverwaltung}
NodeCAOS:= MakeNode1($3F38,$3103,$01FF,0,8,IRom[0]);
InsertKCModul(NodeCAOS); IRom[0]:=0; {ROM in Eigenverwaltung}
end;
InsertKCModul(MakeNode1(0,$0108,$00F4,Ofs(SwitchM022),16,0));
InsertKCModul(MakeNode1(0,$010C,$00F4,Ofs(SwitchM022),16,0));
PortsOut[$80]:=ofs(IOW80);
PortsOut[$88]:=ofs(KC3IOW88);
PortsOut[$89]:=ofs(KC3IOW89);
InsertKC3CTC;
end;
KCEV_Repaint: IRM_Update3;
KCEV_Done: begin
ClearKCModules;
BroadcastIoEvent(IOEV_Destroy);
ClearIoNodes;
end;
KCEV_Copy: begin {hoffentlich ist der IRM an!}
SetClipboardData(CF_Text,
GetScreenText(40,32,Ptr(MemKCSel,$B200),KC2Ansi));
end;
end;
end;
function Event4(Msg,wParam:Word; lParam:LongInt):LongInt; far;
begin
Def_KCM_Event(Msg,wParam,lParam);
case Msg of
KCEV_Init: begin
IRom[1]:=GlobalReAlloc(IRom[1],$2000,GMEM_ZeroInit);
KCIRM.Sel:=PageAlloc(64);
KCIRM.Ofs:=0;
KC4Port84H:=0; {z.Z. Pixel-Zugriff, hohe Auflösung}
KC4Port86H:=0;
KC4Port88H:=$FF;
KC4Port89H:=$FF;
PortsOut[$80]:=ofs(IOW80);
PortsOut[$84]:=ofs(IOW4_84);
PortsOut[$85]:=ofs(IOW4_84);
PortsOut[$86]:=ofs(IOW4_86);
PortsOut[$87]:=ofs(IOW4_86);
PortsOut[$88]:=ofs(IOW4_88);
PortsOut[$89]:=ofs(IOW4_89);
InsertKC3CTC;
{InitKCModules;}
end;
KCEV_Repaint: IRM_Update4;
KCEV_Done: begin
BroadcastIoEvent(IOEV_Destroy);
ClearIoNodes;
ClearKCModules; {noch keine in Betrieb...}
KCIRM.Sel:=PageFree(KCIRM.Sel);
end;
KCEV_Copy: begin {hoffentlich ist der IRM an!}
SetClipboardData(CF_Text,
GetScreenText(40,32,Ptr(MemKCSel,MemW[MemKCSel:$B7CB]),KC2Ansi));
end;
end;
end;
function Event8(Msg,wParam:Word; lParam:LongInt):LongInt; far;
begin
SendDriverMessage(UserInfo.hDrv,Msg,lParam,LongInt(@UserInfo));
end;
function Event9(Msg,wParam:Word; lParam:LongInt):LongInt; far;
begin
case Msg of
KCEV_Init: begin
lstrcpy(PChar(lParam),'KCZ1013');
end;
KCEV_Repaint: IRM_Update9;
KCEV_Done: begin
end;
KCEV_Reset: Regs.pc:=$F000; {PowerOn- und Reset-Startpunkt}
KCEV_KeyDown: asm
mov ax,[wParam]
xor ah,ah
cmp al,$08; jc @@k1
cmp al,$0C; jc @@ke; jz @@k1
cmp al,$0D; jz @@ke
cmp al,$16; jc @@k1
cmp al,$18; jc @@ke
cmp al,$20; jz @@ke; jnc @@k2;
@@k1: add al,$40; or ah,2; jmp @@ke
@@k2: cmp al,$2a; jnc @@k3; add al,$10; or ah,4; jmp @@ke
@@k3: cmp al,$3a; jc @@ke
cmp al,$40; jnc @@k4; sub al,$10; or ah,4; jmp @@ke
@@k4: cmp al,$60; jc @@ke
cmp al,$80; jnc @@k5; sub al,$20; or ah,4; jmp @@ke
@@k5: xor al,al
@@ke: mov [Z1013Key],ax
end;
KCEV_KeyUp: Z1013Key:=0;
KCEV_Copy: begin
SetClipboardData(CF_Text,
GetScreenText(32,32,Ptr(MemKCSel,$EC00),NoConversion));
end;
end;
end;
const
KCInfo: array[1..9] of TKCInfo=(( {KC85/1 - Z9001}
memwrite: ofs(MemWrite1);
ioread: ofs(IORead4);
iowrite: ofs(DispatchIOWrite);
intchk: ofs(DefDoNothing);
event: Event1;
screen: (x:320; y:192);
color: false;
freq: 2458;
rom:(10131,9001,006,9002);
romaddr:(0,$F000,$C000,$E000);
defpal: Ofs(DefPal1)
),( {KC85/2 - HC900}
memwrite: ofs(MemWrite3);
ioread: ofs(IORead4);
iowrite: ofs(DispatchIOWrite);
intchk: ofs(DefDoNothing);
event: Event3;
screen: (x:320; y:256);
color: true;
freq: 1750;
rom:(220,221,0,0);
romaddr:($E000,$F000,0,0);
defpal: Ofs(DefPal3)
),( {KC85/3}
memwrite: ofs(MemWrite3);
ioread: ofs(IORead4);
iowrite: ofs(DispatchIOWrite);
intchk: ofs(DefDoNothing);
event: Event3;
screen: (x:320; y:256);
color: true;
freq: 1750;
rom:(310,006,0,0);
romaddr:($E000,$C000,0,0);
defpal: Ofs(DefPal3)
),( {KC85/4}
memwrite: ofs(MemWrite4);
ioread: ofs(IORead4);
iowrite: ofs(DispatchIOWrite);
intchk: ofs(DefDoNothing);
event: Event4;
screen: (x:320; y:256);
color: true;
freq: 1750;
rom:(420,421,006,0);
romaddr:($E000,$C000,0,0);
defpal: Ofs(DefPal3)
),( {KC85/5 mit CAOS 4.3 (ML)}
memwrite: ofs(MemWrite4);
ioread: ofs(IORead4);
iowrite: ofs(DispatchIOWrite);
intchk: ofs(DefDoNothing);
event: Event4;
screen: (x:320; y:256);
color: true;
freq: 1750;
rom:(430,431,006,0);
romaddr:($E000,$C000,0,0);
defpal: Ofs(DefPal3)
),( {KC85/3 mit CAOS 3.4 (h#s)}
memwrite: ofs(MemWrite3);
ioread: ofs(IORead4);
iowrite: ofs(DispatchIOWrite);
intchk: ofs(DefDoNothing);
event: Event3;
screen: (x:320; y:256);
color: true;
freq: 1750;
rom:(340,006,0,0);
romaddr:($E000,$C000,0,0);
defpal: Ofs(DefPal3)
),( {KC87 mit Farboption}
memwrite: ofs(MemWrite7);
ioread: ofs(IORead4);
iowrite: ofs(DispatchIOWrite);
intchk: ofs(DefDoNothing);
event: Event7;
screen: (x:320; y:192);
color: true;
freq: 2458;
rom:(10131,9001,006,9002);
romaddr:(0,$F000,$C000,$E000);
defpal: Ofs(DefPal7)
),( {Z1013 mit Brosig-ROM}
memwrite: ofs(MemWrite8);
ioread: ofs(IORead13);
iowrite: ofs(IOWrite13);
intchk: ofs(DefDoNothing);
event: Event9;
screen: (x:256; y: 256);
color: false;
freq: 2000;
rom:(10131,10132,0,0); {ZG und Brosig-ROM (4K)}
romaddr:(0,$F000,0,0);
defpal: Ofs(DefPal1)
),( {Z1013 mit A2-ROM}
memwrite: ofs(MemWrite9);
ioread: ofs(IORead13);
iowrite: ofs(IOWrite13);
intchk: ofs(DefDoNothing);
event: Event9;
screen: (x:256; y: 256);
color: false;
freq: 2000;
rom:(10131,10130,0,0);
romaddr:(0,$F000,0,0);
defpal: Ofs(DefPal1)
));
procedure PowerOn;
begin
InsertROMs;
DoReset; {CPU-Register rücksetzen}
CallEvent(KCEV_Reset,0,0);
SetBlock(EmuBlock and not $10); {F9-Block aufheben}
end;
procedure MakeReset;
begin
DoReset; {CPU-Register rücksetzen}
BroadcastIoEvent(IOEV_Reset);
CallEvent(KCEV_Reset,1,0);
SetBlock(EmuBlock and not $10); {F9-Block aufheben}
end;
procedure RemoveAnySelection; forward;
procedure RemoveET(S:PChar); assembler;
{&(ET)-Zeichen entfernen, auch für japanisches Windows}
asm cld
les di,[S]
mov si,di
@@l: seges lodsb
cmp al,'&'
je @@j {alle '&' übergehen, doppelte einfach!}
stosb
push es
push ax
push ax
call IsDbcsLeadByte {Windows-Funktionen belassen SI und DI}
or ax,ax
pop ax
pop es
jz @@n
@@j: seges lodsb {Nachfolge-Zeichen unbesehen kopieren}
stosb {allerdings auf Null testen!}
@@n: or al,al
jnz @@l
end;
procedure SetNewKC(NewKCTyp: Integer);
{hier erfolgt zentral die Ressourcenverwaltung für die einzelnen Typen.
Bei Übergabe von 0 werden alle Ressourcen freigegeben}
var
M: HMenu;
R: TRect;
I: Integer;
begin
RemoveAnySelection;
if KCTyp<>NewKCTyp then begin
M:=GetMenu(MainWnd);
if KCTyp<>0 then begin
CheckMenuItem(M,KCTyp+210,MF_Unchecked);
CallEvent(KCEV_Done,0,0);
if Blinken and (KCPixMap.c>2) then KillTimer(MainWnd,1);
for I:=0 to 3 do
if IRom[I]<>0 then IRom[I]:=THandle(FreeResource(IRom[I]));
if KCTyp>=10 then begin
if UserInfo.hDrv<>0
then CloseDriver(UserInfo.hDrv,UserInfo.user,LongInt(@UserInfo));
SetBlock(EmuBlock and not $20); {NoDLL-Block aufheben}
end;
end;
KCTyp:=NewKCTyp;
if KCTyp<>0 then begin
CheckMenuItem(M,KCTyp+210,MF_Checked);
GetMenuString(M,KCTyp+210,KCName,sizeof(KCName),0);
RemoveET(KCName);
ChrBoxKC.X:=8; ChrBoxKC.Y:=8; {für die meisten Computer der Fall}
ChrBoxChanged;
if KCTyp>=10 then begin
{ Move(screen,UserInfo.screen,12);
Move(rom,UserInfo.rom,32);}
lstrcat(KCName,'.KCE');
UserInfo.hDrv:=OpenDriver(KCName,nil,LongInt(@UserInfo));
if UserInfo.hDrv<>0 then begin
{ Move(UserInfo.screen,screen,12);
Move(UserInfo.rom,rom,32);}
end else begin
SetBlock(EmuBlock or $20); {NoDLL-Block setzen}
MBox1(MainWnd,108,KCName);
end;
end else with KCInfo[KCTyp] do begin
SetPalette(Ptr(Seg(HInstance),defpal));
SetNewPixmap(screen.x,screen.y,color);
FillWord(PortsOut,256,ofs(DefDoNothing));
FillWord(PortsIn,256,ofs(DefIORead));
if Blinken and (KCPixMap.c>2) then SetTimer(MainWnd,1,400,nil);
KCClock:=freq;
{ FetchInstruction:=ofs(DefFetchInstruction);}
MemWR:=memwrite;
IORd:=ioread;
IOWr:=iowrite;
CallEvent:=event;
{Initiale ROMs laden}
for I:=0 to 3 do begin
if rom[I]<>0 then begin
IRom[I]:=LoadROM(rom[I]);
IRomAddr[I]:=romaddr[I]; {Standard-Einblendadresse}
end;
end;
end;
CallEvent(KCEV_Init,0,LongInt(@CurrentHelpFile));
if GetFileNameExt(CurrentHelpFile)^=#0
then lstrcat(CurrentHelpFile,'.HLP');
PowerOn; {RESET-Signal}
CallEvent(KCEV_Repaint,0,0);
end else ClearDisplayBuffer; {Display aufräumen}
end;
end;
function MakeWaveBlock(var M:THandle):PWaveHdr;
{benutzt globale Variablen hWav und Modus}
var
WH: PWaveHdr;
begin
M:=GlobalAlloc(GHND or GMEM_Share,sizeof(TWaveHdr)+WAVBLK);
WH:=GlobalLock(M);
WH^.lpData:=PChar(WH)+sizeof(TWaveHdr);
WH^.dwBufferLength:=WAVBLK;
WaveOutPrepareHeader(hWav,WH,sizeof(TWaveHdr));
MakeWaveBlock:=WH;
end;
function FreeWaveBlock(Wav:HWave; var M:THandle):Boolean;
var
WH: PWaveHdr;
begin
WH:=GlobalLock(M); {Pointer beschaffen}
WaveOutUnprepareHeader(Wav,WH,sizeof(TWaveHdr));
GlobalUnlock(M);
GlobalUnlock(M); {der Block war die ganze Zeit gelockt!}
M:=GlobalFree(M);
FreeWaveBlock:=true;
end;
procedure HandleMMError(Code:Integer);
var
S: array[byte]of Char;
begin
case Code of
MMSysErr_Allocated: MBox1(MainWnd,117,nil);
WAVERR_Sync: MBox1(MainWnd,116,nil);
else begin
WaveInGetErrorText(Code,S,sizeof(S));
MBox1(MainWnd,118,S)
end;
end;
end;
procedure SetSound(OnOff:Boolean);
var
I:integer;
begin
if OnOff then begin
if WaveOption=1 then begin
I:=WaveOutOpen(@hWav,WaveOutDev,PWaveFormat(@MyWav),
MainWnd,0,Callback_Window);
if I<>0 then begin
WaveOption:=0; {kein Sound!!}
HandleMMError(I);
end else begin
CurWaveHdr:=nil;NextWaveHdr:=nil;
end;
end;
end else begin
WaveOutReset(hWav);
WaveOutClose(hWav);
CurWaveHdr:=nil;NextWaveHdr:=nil;
end;
end;
{***********************}
{** Dialog-Prozeduren **}
{***********************}
function EmuSetProc(Wnd:HWnd; Msg,wParam:Word; lParam:LongInt):Bool; export;
var
lPar: LongRec absolute lParam;
W,Mask: Word;
S: array[0..31] of Char;
begin
EmuSetProc:=false;
case Msg of
WM_InitDialog: begin
lParam:=LongDivWR(KCClock,1000);
wvsprintf(S,'%u.%03u',lParam);
SetDlgItemText(Wnd,110,S);
CheckDlgButton(Wnd,111+MenuFlags and 1,1);
CheckDlgButton(Wnd,114+MenuFlags shr 3 and 1,1);
Mask:=EmuBlockMask;
for W:=101 to 103 do begin
if Mask and 1 =0 then CheckDlgButton(Wnd,W,1);
Mask:=Mask shr 1;
end;
EmuSetProc:=true;
end;
WM_Command: case wParam of
ID_OK: begin
W:=GetDlgItem(Wnd,110);
GetWindowText(W,S,sizeof(S));
if ScanFreq(S,@KCClock) then begin
SetMenuFlags(MenuFlags and not $9
or IsDlgButtonChecked(Wnd,112)
or IsDlgButtonChecked(Wnd,115) shl 3);
Mask:=0;
for W:=103 downto 101 do begin
Mask:=Mask shl 1;
if IsDlgButtonChecked(Wnd,W)<>1 then Inc(Mask);
end;
EmuBlockMask:=Mask;
EndDialog(Wnd,1);
end else begin
MBox1(Wnd,111,S);
SetFocus(W);
SendMessage(W,EM_SetSel,0,$FFFF0000);
end;
end;
ID_Cancel: EndDialog(Wnd,2);
9: WinHelp(Wnd,HelpFile,HELP_Context,207);
end;
end;
end;
function DispSetProc(Wnd:HWnd; Msg,wParam:Word; lParam:LongInt):Bool; export;
var
lPar: LongRec absolute lParam;
W,Mask: Word;
begin
DispSetProc:=false;
case Msg of
WM_InitDialog: begin
CheckDlgButton(Wnd,105+EmuShowClock and 3,1);
if EmuShowClock and 4 <>0 then CheckDlgButton(Wnd,108,1);
if EmuShowClock and 8 <>0 then CheckDlgButton(Wnd,104,1);
if UseWinG then begin
CheckDlgButton(Wnd,101,1);
if WinGBM<>0 then CheckDlgButton(Wnd,109,1); {nur als Anzeige}
end;
if Blinken then CheckDlgButton(Wnd,102,1);
DispSetProc:=true;
end;
WM_Command: case wParam of
ID_OK: begin
for W:=105 to 107 do if IsDlgButtonChecked(Wnd,W)=1 then break;
SetShowClock(W-105
or IsDlgButtonChecked(Wnd,108) shl 2
or IsDlgButtonChecked(Wnd,104) shl 3);
SetWinGUse(IsDlgButtonChecked(Wnd,101)=1);
SetBlinken(IsDlgButtonChecked(Wnd,102)=1);
EndDialog(Wnd,1);
end;
ID_Cancel: EndDialog(Wnd,2);
9: WinHelp(Wnd,HelpFile,HELP_Context,208);
end;
end;
end;
function SoundSetProc(Wnd:HWnd; Msg,wParam:Word; lParam:LongInt):Bool; export;
var
S: array[0..255] of Char;
WaveOutCaps: TWaveOutCaps absolute S;
WaveInCaps: TWaveInCaps absolute S;
lPar: LongRec absolute lParam;
W,Mask: Word;
I,J,K:integer;
WODProc,WIDProc: Integer;
begin
SoundSetProc:=false;
WODProc:=WaveOutDev;
case Msg of
WM_InitDialog: begin
CheckDlgButton(Wnd,101+WaveOption,1);
EnableWindow(GetDlgItem(Wnd,112),WaveOption=1);
EnableWindow(GetDlgItem(Wnd,123),WaveOption=2);
{ EnableWindow(GetDlgItem(Wnd,106),false); ..schon in Ressource..}
W:=GetDlgItem(Wnd,112); {Handle Kombobox WaveOUT}
I:=WaveOutGetNumDevs;
for J:=-1 to I-1 do begin {mit Wave_Mapper beginnen}
if (WaveOutGetDevCaps(Word(J),@WaveOutCaps,sizeof(WaveOutCaps))=0)
and (WaveOutCaps.dwFormats and WAVE_Format_2M08 <>0)
and (WaveOutCaps.dwSupport and WAVECAPS_Sync =0) then begin
K:=SendMessageP(W,CB_AddString,0,@WaveOutCaps.szPName);
SendMessage(W,CB_SetItemData,K,J);
if J=WaveOutDev then SendMessage(W,CB_SetCurSel,K,0);
end;
end;
W:=GetDlgItem(Wnd,113); {Handle Kombobox WaveIN}
I:=WaveInGetNumDevs;
for J:=-1 to I-1 do begin {mit Wave_Mapper beginnen}
if (WaveInGetDevCaps(Word(J),@WaveInCaps,sizeof(WaveInCaps))=0)
and (WaveInCaps.dwFormats and WAVE_Format_2M08 <>0) then begin
K:=SendMessageP(W,CB_AddString,0,@WaveInCaps.szPName);
SendMessage(W,CB_SetItemData,K,J);
if J=WaveInDev then SendMessage(W,CB_SetCurSel,K,0);
end;
end;
SoundSetProc:=true;
end;
WM_Command: case wParam of
101..104: begin
EnableWindow(GetDlgItem(Wnd,112),wParam=102);
EnableWindow(GetDlgItem(Wnd,113),wParam=103);
end;
112: if lPar.Hi=CBN_SelChange then begin
I:=SendMessage(lPar.Lo,CB_GetCurSel,0,0);
if I>=0 then WODProc:=SendMessage(lPar.Lo,CB_GetItemData,I,0);
end;
113: if lPar.Hi=CBN_SelChange then begin
I:=SendMessage(lPar.Lo,CB_GetCurSel,0,0);
if I>=0 then WIDProc:=SendMessage(lPar.Lo,CB_GetItemData,I,0);
end;
ID_OK: begin
case WaveOption of
1,2: SetSound(false);
3: asm xor ax,ax; cwd; call KC3SoundR end;
end;
W:=GetDlgItem(Wnd,112);
I:=SendMessage(W,CB_GetCurSel,0,0);
if I>=0 then WaveOutDev:=SendMessage(W,CB_GetItemData,I,0);
W:=GetDlgItem(Wnd,113);
I:=SendMessage(W,CB_GetCurSel,0,0);
if I>=0 then WaveInDev:=SendMessage(W,CB_GetItemData,I,0);
for WaveOption:=0 to 3 do
if IsDlgButtonChecked(Wnd,101+WaveOption)=1 then break;
if WaveOption in [1,2] then SetSound(true);
EndDialog(Wnd,1);
end;
ID_Cancel: EndDialog(Wnd,2);
9: WinHelp(Wnd,HelpFile,HELP_Context,209);
end;
end;
end;
const
stConfigKey='KCEMU\config';
stPlacement='placement';
stKCTyp ='kctyp';
stDisplay ='display';
stSound ='sound';
stKCLoad ='KCEMU\KCLOAD'; {nur damit KCLOAD von der Installation weiß}
procedure LoadConfig;
var
wp: TWindowPlacement;
S: array[0..255]of Char;
SP: PChar;
I: Integer;
Key: HKey; {Mit geöffnetem Schlüssel geht's schneller!}
begin
if RegOpenKey(HKCR,stConfigKey,Key)<>0 then exit;
if RegGetVal(Key,stPlacement,S,sizeof(S))
then with wp do begin
Installed:=true;
SP:=S;
length:=sizeof(wp);
ScanInt(SP,Integer(CmdShow));
if HPrevInst=0 then begin {nur das 1. Fenster nach Konfig setzen!}
{vermeidet das exakte Übereinanderplazieren, was den User verwirrt}
ShowCmd:=SW_Hide;
flags:=0;
ScanInt(SP,rcNormalPosition.left);
rcNormalPosition.right:=rcNormalPosition.left+KCPixmap.x+Saum.x;
ScanInt(SP,rcNormalPosition.top);
rcNormalPosition.bottom:=rcNormalPosition.top+KCPixmap.y+Saum.y;
ScanInt(SP,ptMaxPosition.x);
ScanInt(SP,ptMaxPosition.y);
SetWindowPlacement(MainWnd,@wp);
end;
end;
if RegGetVal(Key,stKCTyp,S,sizeof(S)) then begin
SP:=S;
if ScanInt(SP,I) then SetNewKC(I);
if ScanInt(SP,I) then SetMenuFlags(I);
if ScanInt(SP,I) then EmuBlockMask:=I;
if ScanInt(SP,I) then ofn.nFilterIndex:=I;
end;
if RegGetVal(Key,stDisplay,S,sizeof(S)) then begin
SP:=S;
if ScanInt(SP,I) then SetShowClock(I);
if ScanInt(SP,I) then SetWinGUse(I=1);
if ScanInt(SP,I) then SetBlinken(I=1);
end;
if RegGetVal(Key,stSound,S,sizeof(S)) then begin
SP:=S;
if ScanInt(SP,I) then WaveOption:=I;
if ScanInt(SP,I) then WaveOutDev:=I;
if ScanInt(SP,I) then WaveInDev:=I;
end;
RegCloseKey(Key);
end;
procedure SaveConfig;
var
wp: TWindowPlacement;
S: array[0..255]of Char;
ia: array[0..4] of Integer;
Key: HKey; {mit geöffnetem Schlüssel sollte das Speichern schneller sein}
begin
RegCreateKey(HKCR,stKCLoad,Key); {Diesen für KCLOAD anlegen}
if RegCreateKey(HKCR,stConfigKey,Key)<>0 then exit;
wp.length:=sizeof(wp);
if GetWindowPlacement(MainWnd,@wp) then begin
ia[0]:=wp.showCmd;
ia[1]:=wp.rcNormalPosition.left;
ia[2]:=wp.rcNormalPosition.top;
ia[3]:=wp.ptMaxPosition.x;
ia[4]:=wp.ptMaxPosition.y;
wvsprintf(S,'%d %d %d %d %d',ia);
RegSetVal(Key,stPlacement,S);
end;
ia[0]:=KCTyp;
ia[1]:=MenuFlags;
ia[2]:=EmuBlockMask;
ia[3]:=ofn.nFilterIndex;
wvsprintf(S,'%d %d %d %d',ia);
RegSetVal(Key,stKCTyp,S);
ia[0]:=EmuShowClock;
ia[1]:=Integer(UseWinG);
ia[2]:=Integer(Blinken);
wvsprintf(S,'%d %d %d',ia);
RegSetVal(Key,stDisplay,S);
ia[0]:=WaveOption;
ia[1]:=WaveOutDev;
ia[2]:=WaveInDev;
wvsprintf(S,'%d %d %d',ia);
RegSetVal(Key,stSound,S);
RegCloseKey(Key);
end;
function InputArgsProc(Wnd:HWnd; Msg,wParam:Word; lParam:LongInt):Bool;
export;
var
ArgP: PArgs absolute lParam;
begin
InputArgsProc:=false;
case Msg of
WM_InitDialog: begin
SetWindowArgs(GetDlgItem(Wnd,100));
InputArgsProc:=true;
end;
WM_Command: case wParam of
ID_OK: begin
if GetWindowArgs(GetDlgItem(Wnd,100))
then EndDialog(Wnd,ID_OK)
else begin
MBox1(Wnd,106,nil);
SetFocus(GetDlgItem(Wnd,100));
end;
end;
ID_Cancel: EndDialog(Wnd,ID_Cancel);
9: WinHelp(Wnd,HelpFile,HELP_Context,102);
end;
end;
end;
function LoadFile(Name:PChar; Typ: Integer; IgnoreROM: Boolean):Boolean;
{Benutzt die globale Variable LoadSaveArgs}
{Typ=0: je nach Endung, =1: .COM,.KCC, =2: .BIN, =3: .SSS,.BAS,...}
{IgnoreROM=true, wenn ROM gnadenlos überschrieben werden soll}
var
Ext: PChar;
f: Integer;
P: PChar; {Hilfsspeicher}
aa,ea,len: Word;
begin
f:=_lopen(Name,0);
if f=-1 then begin
MBox1(MainWnd,105,Name); {Huch?}
exit;
end;
if Typ=0 then begin
Ext:=GetFileNameExt(Name);
Typ:=2; {Normalerweise: Speicherabzug}
if (lstrcmpi(Ext,'.COM')=0) or (lstrcmpi(Ext,'.KCC')=0) then Typ:=1;
if (lstrcmpi(Ext,'.SSS')=0) or (lstrcmpi(Ext,'.BAS')=0) then Typ:=3;
if lstrcmpi(Ext,'.Z80')=0 then Typ:=4;
end;
if LoadSaveArgs.argn=0 then begin {Adressen erfragen}
if not GetFileArgs(f,Typ) then begin
MBox1(MainWnd,105,nil);
exit;
end;
if DialogBox(Seg(HInstance),MakeIntResource(102),MainWnd,
@InputArgsProc)<>ID_OK then exit;
end;
if LoadSaveArgs.argn>=1 then aa:=LoadSaveArgs.arg[1];
if LoadSaveArgs.argn>=2 then len:=LoadSaveArgs.arg[2]-aa;
case Typ of
1: begin {Maschinenprogramm}
if LoadSaveArgs.argn<2 then exit;
_llseek(f,$80,0);
end;
2: begin {Speicherabzug}
if LoadSaveArgs.argn<1 then exit;
len:=_llseek(f,0,2); {Länge der Datei bestimmen (hoffentlich <64K)}
if LoadSaveArgs.argn>=2
then len:=minW(len,LoadSaveArgs.arg[2]-aa);
_llseek(f,0,0);
end;
3: begin {BASIC-Programm}
if LoadSaveArgs.argn<1 then aa:=$401;
_llseek(f,0,0);
_lread(f,PChar(@len),2); {Länge holen}
if LoadSaveArgs.argn>=2 then len:=minW(len,LoadSaveArgs.arg[2]-aa);
ea:=aa+len;
if LoadKCMem(@ea,$3D7,2)
and LoadKCMem(@ea,$3D9,2)
and LoadKCMem(@ea,$3DB,2) {Endadresse eintragen, Variablen löschen}
then else MBox1(MainWnd,120,nil);
end;
4: begin
_llseek(f,$20,0);
end;
end;
if IgnoreROM then _lread(f,Ptr(MemKCSel,aa),len)
else begin
P:=Ptr(GlobalAlloc(GMEM_Fixed,len),0);
_lread(f,P,len);
if LoadKCMem(P,aa,len)
then else MBox1(MainWnd,120,nil);
GlobalFree(PtrRec(P).Sel);
end;
_lclose(f);
if LoadSaveArgs.argn=3 then Regs.PC:=LoadSaveArgs.arg[3];
end;
function SaveFile(Name:PChar; Typ: Integer):Boolean;
{Benutzt die globale Variable LoadSaveArgs}
{Typ=1: .COM,.KCC, =2: .BIN, =3: .SSS,.BAS, =4:Z80...}
var
Ext: PChar;
f: Integer;
len: Word;
hdr: TFullKccHdr;
Z80Hdr: TZ80Hdr absolute hdr;
begin
SaveFile:=false;
f:=_lcreat(Name,0);
if f=-1 then begin
MBox1(MainWnd,105,Name); {Huch?}
exit;
end;
case Typ of
1: begin {KCC-Programm}
lstrcpyn(hdr.name,GetFileNamePtr(Name),sizeof(hdr.name));
if (LoadSaveArgs.argn=0) {Adressen erfragen}
and (DialogBox(Seg(HInstance),MakeIntResource(102),MainWnd,
@InputArgsProc)<>ID_OK)
then begin
_lclose(f);
exit;
end;
hdr.args:=LoadSaveArgs;
_lwrite(f,PChar(@hdr),128);
end;
2: begin {Speicherabzug}
if (LoadSaveArgs.argn=0) {Adressen erfragen}
and (DialogBox(Seg(HInstance),MakeIntResource(102),MainWnd,
@InputArgsProc)<>ID_OK)
then begin
_lclose(f);
exit;
end;
end;
3: begin {BASIC-Programm (Disketten-Format)}
LoadSaveArgs.argn:=2;
LoadSaveArgs.arg[1]:=$401;
LoadSaveArgs.arg[2]:=MemW[MemKCSel:$3D7];
if (LoadSaveArgs.arg[2]<=$401)
or (LoadSaveArgs.arg[2]>=$C000)
then begin
_lclose(f);
MBox(MainWnd,113,LoadSaveArgs.arg[2]); {Kann nicht speichern!}
exit;
end;
len:=LoadSaveArgs.arg[2]-LoadSaveArgs.arg[1];
_lwrite(f,PChar(@len),2); {Länge schreiben}
end;
4: begin
FillChar(Z80Hdr,sizeof(Z80Hdr),0);
lstrcpyn(Z80Hdr.name,GetFileNamePtr(name),sizeof(Z80Hdr.name));
if (LoadSaveArgs.argn=0) {Adressen erfragen}
and (DialogBox(Seg(HInstance),MakeIntResource(102),MainWnd,
@InputArgsProc)<>ID_OK)
then begin
_lclose(f);
exit;
end;
Z80Hdr.arg:=LoadSaveArgs.arg;
Z80Hdr.typ:='M'; if LoadSaveArgs.argn=3 then Z80Hdr.typ:='C';
FillChar(Z80Hdr.magic,sizeof(Z80Hdr.magic),#$D3);
_lwrite(f,PChar(@Z80Hdr),sizeof(Z80Hdr));
end;
end;
len:=LoadSaveArgs.arg[2]-LoadSaveArgs.arg[1];
if _lwrite(f,Ptr(MemKCSel,LoadSaveArgs.arg[1]),len)<>len
then MBox1(MainWnd,112,Name); {"Fehler beim Schreiben"}
SaveFile:=_lclose(f)=0;
end;
procedure PokeChar(C:Char);
begin
CallEvent(KCEV_KeyDown,Word(C),0);
end;
procedure PokeChar2(W:Word);
begin
if (KCTyp=5) and (Mem[MemKCSel:$B7A2] and $20 <>0) {IBM-Zeichensatz?}
then PokeChar(Char(Hi(W)))
else PokeChar(Char(Lo(W)));
end;
procedure PokeKey(W:Word); assembler;
asm push VK_Shift
call GetKeyState
test ax,$FFFE
mov ax,W {Low-Teil ohne Shift}
jz @@1
xchg al,ah {High-Teil mit Shift}
@@1: push ax
call PokeChar
end;
var
BremsZeit: Word;
BremsTick: LongInt;
procedure DirtyHack; near; assembler;
asm mov es,[MemKCSel]
mov bx,[Regs.IX]
add bx,8
mov al,es:[bx]
test al,2
jz @@e
and al,not 2
jmp [memwr]
@@e: end;
function WriteB:Boolean;
{Kontext: MMTASK.TSK}
begin
WriteB:=true;
if Z1013Port2<$80
then CurWaveHdr^.lpData[ByteIndex]:=char($0)
else CurWaveHdr^.lpData[ByteIndex]:=char($FF);
Inc(ByteIndex);
if ByteIndex>=LongRec(CurWaveHdr^.dwBufferLength).Lo then begin
WaveOutWrite(hWav,CurWaveHdr,sizeof(TWaveHdr)); {vollen Puffer hinein}
if NextWaveHdr=nil then begin CurWaveHdr:=nil;WriteB:=false;
end else begin CurWaveHdr:=NextWaveHdr;NextWaveHdr:=nil;end;
ByteIndex:=0;
end;
end;
function IdleAction:Boolean;
{Hier kommt der Code der Emulation hin. Routine sollte nicht länger als
100 ms in Anspruch nehmen, da dann gestörter Bildaufbau und zähes Windows.
IdleAction liefet normalerweise TRUE, was bedeutet: Emulation fortsetzen.
Wenn das Programm dagegen z.B. auf Taste wartet, FALSE zurückgeben, damit
Windows (und damit die CPU eines Laptops) "idlen" kann.}
const
ExitCounter: Word=0; {zur automatischen Festlegung einer möglichst
kleinen Expire-Zeit; für flüssigere Animationen auf schnellen Rechnern}
var
T,I: Word;
L: LongInt;
S: array[0..32] of Char;
begin
IdleAction:=false;
if MemWr=0 then exit;
SetBlock(EmuBlock and not 4); {Es fehlt da ein WM_LeaveIdle...}
if EmuBlock<>0 then exit;
{$Q-}
case WaveOption of
1: begin
{ asm int 3 end;}
If CurWaveHdr=nil then exit;
repeat
for I:=0 to 65535 div 90 do begin
Expire:=90;
CpuEmu;
if not WriteB then exit;
end;
{ DirtyHack;}
until Word(GetTickCount)-T >= LastPaintTime;
IdleAction:=true;
end;
else begin
IdleAction:=true;
T:=Word(GetTickCount);
if MenuFlags and 1 <>0 then begin {Bremsen!}
I:=T-BremsZeit; {Differenz seit letzter Zeitnahme}
L:=cTicks-BremsTick;
if LongRec(L).Hi>=KCClock then begin
L:=0; {Notnagel!}
BremsTick:=cTicks;
end;
if I+54 < lLongDivW(L,KCClock) then begin
if ExitCounter<$FFFF then Inc(ExitCounter);
exit;
end;
if I>100 then begin {nicht zu lange "nachlaufen"!}
if cTicks-BremsTick > LongMulW(200,KCClock)
then BremsTick:=cTicks-LongMulW(0,KCClock)
else Inc(BremsTick,LongMulW(I,KCClock));
BremsZeit:=T;
end;
end{ else BremsTick:=cTicks}; {Hm, immer?}
repeat
if MenuFlags and 1 <>0 then case ExitCounter of
0..3: Expire:=65535;
4..10: Expire:=$7FFF;
11..20: Expire:=$1FFF;
21..40: Expire:=$0FFF;
41..80: Expire:=$03FF;
else Expire:=$07F;
end else Expire:=65535;
{ asm int 3 end;}
CpuEmu;
{ if KCTyp in [2..6] then DirtyHack;}
until Word(GetTickCount)-T >= LastPaintTime;
ExitCounter:=0;
end;
end;
LastPaintTime:=0;
GC_ShortCircuit:=false;
if EmuShowClock and 3 <>0 then begin
T:=Word(GetTickCount); I:=T-TimeTaken;
if I>=1000 then begin {Zeitdifferenz (Intervall) >=1 Sekunde?}
SetFreq(lLongDivW(cTicks-TickTaken,I)); {in kHz}
TickTaken:=cTicks;
TimeTaken:=T;
end;
end;
end;
function PasteString(S:PChar):Boolean;
label raus;
const
PasteTimeOut=200; {Millisekunden für Zeicheneinfügung}
PasteEnterTimeOut=2000; {mehr Zeit für ENTER-Taste}
var
SaveEmuBlock: Byte; {während PASTE Emulator aktivieren}
Msg: TMsg;
T,TOut: Word;
PasteOK: Bool;
LastEnter: Boolean;
begin
SaveEmuBlock:=EmuBlock;
SetBlock(0);
LastEnter:=false;
while S^<>#0 do begin
if S^<>#10 then begin {nur 0Dh (ENTER) verarbeiten}
TOut:=PasteTimeOut;
if LastEnter then TOut:=PasteEnterTimeOut;
LastEnter:=S^=#13;
T:=Word(GetTickCount); {Start-Zeit nehmen}
CallEvent(KCEV_KeyDown,Word(S^),0);
repeat
while PeekMessage(Msg,0,0,0,PM_Remove) do begin
if Msg.message<WM_KeyFirst then begin {Keine Kdo's verarbeiten}
if (Msg.message=WM_KeyDown)
and (Msg.wParam=VK_Cancel) then goto raus;
if Msg.message=WM_Quit then asm int 3 end;
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
IdleAction;
PasteOK:=false; {der Z1013 hat keine PasteOK-Möglichkeit}
CallEvent(KCEV_PasteHint,0,LongInt(@PasteOK));
until PasteOK or (Word(GetTickCount)-T>=TOut);
end;
Inc(S);
end;
raus:
SetBlock(SaveEmuBlock);
end;
function TakeScreenshot:THandle;
{kopiert die momentane Pixmap und entfernt Blinkfarben}
var
HMem: THandle;
P: PChar; {Wandernder Zeiger}
bih: PBitmapInfoHeader absolute P; {Alias}
col: PRGBQuad absolute P; {Alias}
siz: LongInt; {(verbleibende) Bytes in Pixmap}
I,J: Integer;
begin
TakeScreenshot:=0;
if hDisplay=0 then exit;
siz:=DisplaySize;
J:=min(KCPixmap.c,24); {Farbzahl, Blinkfarben auslassen!}
HMem:=GlobalAlloc(GMEM_Share,sizeof(TBitmapInfoHeader)+(J shl 2)+siz);
P:=GlobalLock(HMem);
bih^:=KCPixmap.bih; {ganze Struktur kopieren}
bih^.biClrUsed:=J; {Farbzahl ggf. minimieren}
Inc(P,sizeof(TBitmapInfoHeader));
for I:=0 to J-1 do with col^,TPaletteEntry(Palette.col[I]) do begin
rgbBlue:=peBlue; {einzelbyteweise, weil verdreht!}
rgbGreen:=peGreen; {in Assembler wäre hier ein stosb so schön!}
rgbRed:=peRed;
rgbReserved:=0;
Inc(P,sizeof(TRGBQuad)); {4 Bytes vorrücken}
end;
hmemcpy(P,Ptr(hDisplay,0),siz); {Pixmap kopieren (lassen)}
if KCPixmap.c>24 then begin {Blinkfarben ausfiltern?}
repeat
asm les di,[P]
mov al,es:[di] {Farb-Index lesen}
sub al,24
cmp al,8 {Blink-Farbe?}
jnc @@1 {nein, unverändert lassen}
mov ah,0
add ax,offset BlinkFarben
xchg bx,ax
mov al,[bx]
or al,al {Z:=0, VFarbe liefern!}
call [GetAnimIdx] {Index computerspezifisch beschaffen}
mov es:[di],al {Index 0..23 hinschreiben}
@@1:end;
IncHP(P,1); {P als Huge-Zeiger vorrücken}
Dec(siz);
until siz=0
end;
GlobalUnlock(HMem);
TakeScreenshot:=HMem;
end;
function CreateTRectRegion:HRgn;
var
R2: TRect;
Rgn1,Rgn2: HRgn; {Hilfsregion zum Zusammensetzen}
label
L1;
begin
Rgn1:=0; Rgn2:=0;
CopyRect(R2,SelectedRect);
if (RandL<RandR) and (R2.top<>R2.bottom) then begin
{So umsortieren, daß der 1. Punkt oben und der 2. Punkt unten ist}
if R2.top>R2.bottom then SetRect(R2,R2.right,R2.bottom,R2.left,R2.top);
{Test auf Anomalie (Mittelbereich hat negative Breite)}
if R2.top+1>R2.bottom then begin
SortRect(R2); {richtig sortieren}
goto L1; {weiter wie ohne Ränder}
end;
{Oberer Schwanz}
if R2.left<RandR then begin
Rgn1:=CreateRectRgn(R2.left,R2.top,RandR,R2.top+1);
end else Rgn1:=0;
Inc(R2.top,1); {weiter 'runter}
{Unterer Schwanz}
if R2.right>RandL then begin
Rgn2:=CreateRectRgn(RandL,R2.bottom,R2.right,R2.bottom+1);
end else Rgn2:=0;
{Kombinieren zu Rgn1}
if Rgn2<>0 then begin
if Rgn1=0 then Rgn1:=Rgn2
else begin
CombineRgn(Rgn1,Rgn1,Rgn2,RGN_XOR);
DeleteObject(Rgn2);
end;
end;
{Mittelbereich}
if R2.top<R2.bottom then begin
Rgn2:=CreateRectRgn(RandL,R2.top,RandR,R2.bottom);
end else Rgn2:=0;
{Kombinieren zu Rgn1}
if Rgn2<>0 then begin
if Rgn1=0 then Rgn1:=Rgn2
else begin
CombineRgn(Rgn1,Rgn1,Rgn2,RGN_XOR);
DeleteObject(Rgn2);
end;
end;
{Wert-Rückgabe}
CreateTRectRegion:=Rgn1;
end else begin
SortRect(R2);
{Nun Rechteck auf (mindestens) Buchstabenhöhe aufblasen}
L1:
Inc(R2.bottom);
CreateTRectRegion:=CreateRectRgnIndirect(R2);
end;
end;
procedure DrawSelection(DC:HDC);
var
OldMap: Integer;
begin
if SelectedRegion<>0 then begin
OldMap:=SetMapMode(DC,MM_AnIsotropic);
SetViewportExt(DC,ChrBox.X,ChrBox.Y);{Bildschirm-Buchstaben}
SetWindowExt(DC,1,1); {ganze Buchstaben}
InvertRgn(DC,SelectedRegion);
SetMapMode(DC,OldMap);
end;
end;
procedure SelectionChanged;
{Aufruf, wenn sich SelectedRect oder RandL/R geändert hat}
var
DC:HDC;
hReg:HRgn;
begin
DC:=GetDC(MainWnd);
if SelectedRegion<>0 then begin
hReg:=CreateTRectRegion;
CombineRgn(SelectedRegion,SelectedRegion,hReg,RGN_XOR);
DrawSelection(DC); {die Differenzmenge "umklappen"}
DeleteObject(SelectedRegion); {alte Selektierung weg!}
SelectedRegion:=hReg; {neue Region setzen}
end else begin
SelectedRegion:=CreateTRectRegion;
DrawSelection(DC);
end;
ReleaseDC(MainWnd,DC);
end;
function Pix2ChrBoxX(x:Integer):Integer;
begin
if ChrBox.x>0 {GPF vermeiden}
then Pix2ChrBoxX:=(ChrBox.X shr 1 +x) div ChrBox.X
else Pix2ChrBoxX:=0;
end;
function Pix2ChrBoxY(y:Integer):Integer;
begin
if ChrBox.y>0 {GPF vermeiden}
then Pix2ChrBoxY:=y div ChrBox.Y
else Pix2ChrBoxY:=0;
end;
procedure MouseDrag(x,y:Integer); {Linke Maustaste gedrückt...}
var
R: TRect;
begin
GetClientRect(MainWnd,R);
x:=Pix2ChrBoxX(max(min(x,R.right-1),0));
y:=Pix2ChrBoxY(max(min(y,R.bottom-1),0));
{Clipping und in Zeichen umrechnen}
if (SelectedRect.right<>x) or (SelectedRect.bottom<>y) then begin
SelectedRect.right:=x;
SelectedRect.bottom:=y; {Neue zweite Ecke}
SelectionChanged;
end;
end;
procedure RemoveAnySelection;
var
DC:HDC;
begin
if SelectedRegion<>0 then begin
DC:=GetDC(MainWnd);
DrawSelection(DC);
SelectedRegion:=0; {Nichts mehr selektiert}
ReleaseDC(MainWnd,DC);
end;
end;
var {Variablen zum Hinüberretten über TrackPopupMenu()}
MouseX: Integer; {Maus-Position vor TrackPopupMenu()}
LineDrawn: Boolean; {Linie eingezeichnet oder nicht?}
Keyword: array[0..9] of Char; {Vorgefundenes Schlüsselwort}
procedure DrawRandLinie(DC:HDC);
var
I: Integer;
R: TRect;
begin
GetClientRect(MainWnd,R);
I:=min(MouseX*ChrBox.X,R.right-1);
SetRect(R,I,0,I,R.bottom-1);
I:=SetROP2(DC,R2_NOT);
PolyLine(DC,R,2);
SetROP2(DC,I);
end;
procedure MakeModeless(var Wnd:HWnd; Res:Word; Proc: TFarProc);
begin
if Wnd<>0 then begin
ShowWindow(Wnd,SW_Restore); {falls ikonifiziert}
SetFocus(Wnd); {sonst: Fokus wechseln!}
end else begin
Wnd:=CreateDialog(Seg(HInstance),MakeIntResource(Res),0,Proc);
end;
end;
procedure FillMenuWithHelpFiles(m: HMenu);
var
S: TS255;
I: Integer;
SR: TSearchRec;
eq: Boolean;
begin
{1. Menü leeren}
for I:=1001 to 1050 do if not DeleteMenu(m,I,MF_ByCommand) then break;
{2. Menü wieder füllen}
GetModuleFileName(Seg(HInstance),S,sizeof(S));
lstrcpy(GetFileNamePtr(S),'*.HLP');
I:=1001;
FindFirst(S,0,SR);
while DosError=0 do begin
eq:=lstrcmpi(SR.Name,CurrentHelpFile)=0;
GetFileNameExt(SR.Name)^:=#0; {Extension entfernen}
AppendMenu(m,MF_String,I,SR.Name);
if eq then CheckMenuItem(m,I,MF_ByCommand or MF_Checked);
Inc(I);
if I>1050 then break;
FindNext(SR);
end;
end;
procedure FillMenuWithUserKCs(m: HMenu);
var
S: TS255;
I: Integer;
SR: TSearchRec;
begin
{1. Menü leeren}
for I:=220 to 229 do if not DeleteMenu(m,I,MF_ByCommand) then break;
{2. Menü wieder füllen}
GetModuleFileName(Seg(HInstance),S,sizeof(S));
lstrcpy(GetFileNamePtr(S),'*.KCE');
I:=220;
FindFirst(S,0,SR);
while DosError=0 do begin
GetFileNameExt(SR.Name)^:=#0; {Extension entfernen}
AppendMenu(m,MF_String,I,SR.Name);
if I-210=KCTyp then CheckMenuItem(m,I,MF_ByCommand or MF_Checked);
Inc(I);
if I>229 then break;
FindNext(SR);
end;
end;
function KCWndProc(Wnd:HWnd; Msg:Word; wParam:Word; lParam:LongInt):
LongInt; export;
const
WM_ContinueInit=WM_User+10;
var
lPar: LongRec absolute lParam;
mmi: PMinMaxInfo absolute lParam;
pt: TPoint absolute lParam;
SP: PChar absolute lParam;
WH: PWaveHdr absolute lParam;
CallOld: Boolean;
SaveEmuBlock: Byte; {während PASTE Emulator aktivieren}
I: Integer;
W: Word;
R: TRect;
PS: TPaintStruct;
S: TS255;
const
SExt: array[0..15]of Char=#0; {Filter-Merker (sonst ist's lästig)}
begin
CallOld:=false;
case Msg of
WM_Create: begin
MainWnd:=Wnd;
W:=GetSystemMenu(Wnd,FALSE);
DeleteMenu(W,SC_SIZE,MF_BYCOMMAND);
LoadString(Seg(HInstance),101,S,sizeof(S)); {Großbild}
ModifyMenu(W,SC_Zoom,MF_ByCommand,SC_Zoom,S);
MemKCSel:=PageAlloc(0); {64K-Fenster}
LoadConfig; {setzt KCTyp usw.}
SetSound(True); {setzt Sound}
TimeTaken:=Word(GetTickCount);
TickTaken:=cTicks;
W:=500; if KCTyp<>0 then W:=5000;
SetTimer(Wnd,2,W,nil);
end;
WM_GetMinMaxInfo: with mmi^ do begin
ptMaxSize.x:=KCPixmap.x*2+Saum.x;
ptMaxSize.y:=KCPixmap.y*2+Saum.y;
end;
WM_Size: begin
case wParam of
SIZE_Minimized: begin
ClrsRealized:=0; {sonst Falschfarben nach Icon öffnen}
SetBlock(EmuBlock or (EmuBlockMask and 1));
end;
SIZE_Maximized: begin
Magnify:=2;
if GetSystemMetrics(SM_CYFullScreen)-GetSystemMetrics(SM_CYMenu)
>= KCPixmap.y*3
then Magnify:=3; {für Auflösungen jenseits 1024x768}
ChrBoxChanged;
SetBlock(EmuBlock and not 1);
end;
SIZE_Restored: begin {Korrektur bei 2zeiligem Menü}
Magnify:=1; ChrBoxChanged;
GetClientRect(Wnd,R);
I:=R.bottom-R.top-KCPixmap.y; {sollte Null sein}
if I<>0 then begin {Korrektur!}
GetWindowRect(Wnd,R);
MoveWindow(Wnd,R.left,R.top,R.right-R.left,R.bottom-R.top-I,true);
end;
SetBlock(EmuBlock and not 1);
end;
end;
DrawTitle; {Titelzeile aktualisieren}
end;
WM_EnterIdle: if EmuBlockMask and 4 <>0
then SetBlock(EmuBlock or 4)
else IdleAction;
WM_ActivateApp: if wParam<>0 then SetBlock(EmuBlock and not 2)
else SetBlock(EmuBlock or (EmuBlockMask and 2));
WM_QueryNewPalette: if ClrsRealized<32 then begin
InvalWnd;
KCWndProc:=1;
end;
WM_PaletteChanged: if wParam<>Wnd then begin
ClrsRealized:=0;
InvalWnd;
end;
WM_Paint: begin
BeginPaint(Wnd,PS);
if hDisplay<>0 then begin
LastPaintTime:=Word(GetTickCount);
SelectPalette(PS.hDC,hPal,false); {Muß auch hier sein!}
if ClrsRealized<32 then ClrsRealized:=RealizePalette(PS.hDC);
if WinGBM<>0 then begin
if Magnify>1 then WinGStretchBlt(PS.hdc,0,0,KCPixmap.x*Magnify,
KCPixmap.y*Magnify,WinGDC,0,0,KCPixmap.x,KCPixmap.y)
else WinGBitBlt(PS.hdc,0,0,KCPixmap.x,KCPixmap.y,
WinGDC,0,0);
end else begin
if Magnify>1 then StretchDIBits(PS.HDC,0,0,KCPixmap.x*Magnify,
KCPixmap.y*Magnify,0,0,KCPixmap.x,KCPixmap.y,Ptr(hDisplay,0),
KCPixmap.bi,DIB_Pal_Colors,SrcCopy)
else SetDIBitsToDevice(PS.HDC,0,0,KCPixmap.x,KCPixmap.y,
0,0,0,KCPixmap.y,Ptr(hDisplay,0),
KCPixmap.bi,DIB_Pal_Colors);
end;
FillChar(InUpdate,sizeof(InUpdate),0);
Regions:=MaxRegions;
LastPaintTime:=(Word(GetTickCount)-LastPaintTime) div 4;
end else FillRect(PS.hDC,PS.rcPaint,GetStockObject(Gray_Brush));
DrawSelection(PS.HDC);
if LineDrawn then DrawRandLinie(PS.hDC);
EndPaint(Wnd,PS);
end;
WM_NCPaint: begin
KCWndProc:=DefWindowProc(Wnd,Msg,wParam,lParam);
if WordRec(LongRec(BorderRGB).Hi).Hi=0 then begin
{Rechteck als 1-Pixel-Umrandung um Client finden}
GetWindowRect(Wnd,R);
pt.x:=KCPixmap.x*Magnify+1;
pt.y:=KCPixmap.y*Magnify+1;
ClientToScreen(Wnd,pt);
R.right:=pt.x-R.left;
R.bottom:=pt.y-R.top;
pt.x:=-1; pt.y:=-1; ClientToScreen(Wnd,pt);
R.left:=pt.x-R.left;
R.top:=pt.y-R.top;
PS.hdc:=GetWindowDC(Wnd);
W:=SelectObject(PS.hdc,GetStockObject(Hollow_Brush));
I:=SelectObject(PS.hdc,CreatePen(PS_Solid,1,BorderRGB));
Rectangle(PS.hdc,R.left,R.top,R.right,R.bottom);
DeleteObject(SelectObject(PS.hdc,I));
SelectObject(PS.hdc,W);
ReleaseDC(Wnd,PS.hdc);
end;
end;
WM_Copy: begin
if OpenClipboard(Wnd) then begin
EmptyClipboard;
SetClipboardData(CF_DIB,TakeScreenshot);
CallEvent(KCEV_Copy,wParam,lParam);
CloseClipboard;
end else MessageBeep(0);
end;
WM_Paste: begin
if OpenClipboard(Wnd) then begin
W:=GetClipboardData(CF_Text);
if W<>0 then begin
lstrcpyn(S,GlobalLock(W),255); {Clipboard-Daten holen (ein paar...)}
GlobalUnlock(W);
if S[0]<>#0 then PasteString(S);
end;
CloseClipboard;
end else MessageBeep(0);
end;
WM_Command: case wParam of
2: SendMessage(Wnd,WM_SysCommand,SC_Close,0);
101: asm int 3 end; {Debug-Break}
102: begin {Datei laden}
PrepareOFN;
asm and LongRec(Ofn.flags).lo,not OFN_HideReadOnly end;
if GetOpenFileName(ofn) then begin
LoadFile(SFile,Integer(ofn.nFilterIndex),
Integer(ofn.Flags) and OFN_ReadOnly <>0);
end;
end;
103: CallEvent(KCEV_Repaint,0,0); {Debug-Repaint}
104: begin
PrepareOFN;
asm or LongRec(Ofn.flags).lo,OFN_HideReadOnly end;
if GetSaveFileName(ofn) then begin
SaveFile(SFile,Integer(ofn.nFilterIndex));
end;
end;
105: MakeModeless(hModul,wParam,@ModulProc);
106: WinExec('KCLOAD.EXE',SW_Show);
107: if WinExec('EXPLORER.EXE',SW_Show)<32
then WinExec('WINFILE.EXE',SW_Show);
108: begin {Installieren}
RegSetRoot('.KCC','KCEMU');
RegSetRoot('.Z80','KCEMU');
RegSetRoot('KCEMU',AppName);
GetModuleFileName(Seg(HInstance),S,sizeof(S));
lstrcat(S,' %1');
RegSetRoot('KCEMU\shell\open\command',S);
SaveConfig;
Installed:=true;
end;
109: begin {Deinstallieren}
RegDeleteKey(HKCR,'.KCC');
RegDeleteKey(HKCR,'.Z80');
lParam:=RegDeleteKey(HKCR,'KCEMU');
if lParam<>0 then begin
MBox1(Wnd,122,PChar(lParam)); {Fehlercode %ld}
end;
Installed:=false;
end;
{ 151: ; {Markieren}
152: SendMessage(Wnd,WM_Copy,0,0); {Kopieren}
153: SendMessage(Wnd,WM_Paste,0,0); {Einfügen (Text)}
160: begin {Linken Rand setzen}
RandL:=MouseX;
if RandR<=RandL then RandR:=KCPixmap.x div ChrBoxKC.x; {Ganz rechts!}
if SelectedRegion<>0 then SelectionChanged;
end;
161: begin {Rechten Rand setzen}
RandR:=MouseX;
if RandL>=RandR then RandL:=0; {Ganz links!}
if SelectedRegion<>0 then SelectionChanged;
end;
162: begin {Umschalten: Rechteckig markieren}
RandL:=0;
if RandR=0 then RandR:=KCPixmap.x div ChrBoxKC.x
else RandR:=0; {Nichts was dazwischen paßt}
if SelectedRegion<>0 then SelectionChanged;
end;
201..203: SetMenuFlags(MenuFlags xor (1 shl (wParam-201)));
204: MakeModeless(hKeymap,wParam,@KeymapProc);
205: begin SetBlock(EmuBlock and not $10); DoNMI; end; {F9-Block}
206: begin MakeReset; end;
207: begin PowerOn; end;
307: DialogBox(Seg(HInstance),MakeIntResource(207),Wnd,@EmuSetProc);
208: DialogBox(Seg(HInstance),MakeIntResource(wParam),Wnd,@DispSetProc);
209: DialogBox(Seg(HInstance),MakeIntResource(wParam),Wnd,@SoundSetProc);
211..229: SetNewKC(wParam-210); {mit max. 10 USER-KCs}
230: SetBlock(EmuBlock xor $10); {Run/Stop-Taste F9}
301: MakeModeless(hDebug,wParam,@DebugProc);
901: WinHelp(Wnd,HelpFile,HELP_Index,0);
902: begin {Schlüsselwort-Suche}
Keyword[0]:=#0;
CallEvent(KCEV_GetKeyword,Word(-1),LongInt(@Keyword));
if Keyword[0]<>#0 then SendMessage(Wnd,WM_Command,903,0)
else MBox1(Wnd,121,nil);
end;
903: begin {Schlüsselwort gefunden}
WinHelp(Wnd,CurrentHelpFile,HELP_PartialKey,LongInt(@Keyword));
end;
909: DialogBox(Seg(HInstance),MakeIntResource(wParam),Wnd,@AboutProc);
910: if not IsIconic(Wnd) then begin
{Umschalten einfache/doppelte Größe (ALT+ENTER)}
I:=SW_ShowMaximized; if IsZoomed(Wnd) then I:=SW_ShowNormal;
ShowWindow(Wnd,I);
end;
1001..1050: begin
lstrcpy(CurrentHelpFile+GetMenuString(GetMenu(Wnd),wParam,
CurrentHelpFile,sizeof(CurrentHelpFile)-4,MF_ByCommand),'.HLP');
end;
else MBox1(Wnd,123,nil); {Nicht implementiert!}
end;
WM_KeyDown: case wParam of
VK_Capital: PokeChar(#$16);
VK_Pause: PokeKey($131B); {STOP/ESC}
VK_Prior: PokeKey($1011); {Page Mode/HOME}
VK_Next: PokeKey($0C12); {Scroll Mode/CLS}
VK_End: PokeKey($1318); {Cursor ans Zeilenende/STOP}
VK_Home: if GetKeyState(VK_Shift) and $FFFE<>0
then AutoInsert:=not AutoInsert {PC-verwöhnte bedienen!}
else PokeChar(#$19); {Cursor auf Zeilenanfang/AutoInsert}
VK_Left: PokeKey($1908);
VK_Up: PokeKey($110B);
VK_Right: PokeKey($1809);
VK_Down: PokeKey($120A);
VK_Insert: PokeKey($141A); {INS/CLICK}
VK_Delete: PokeKey($021F); {DEL/CLLN}
VK_Escape: if GetKeyState(VK_Shift) and $FFFE <>0 then PokeKey($1B);
VK_F1..VK_F6: PokeKey((wParam-VK_F1+$F1)*$101+$600); {F-Tasten}
end;
WM_KeyUp: CallEvent(KCEV_KeyUp,0,0);
WM_Char: case Char(wParam) of
'─': PokeChar2($8E7B); {'Ä'}
'╓': PokeChar2($997C); {'Ö'}
'▄': PokeChar2($9A7D); {'Ü'}
'Σ': PokeChar2($845B); {'ä'}
'÷': PokeChar2($945C); {'ö'}
'ⁿ': PokeChar2($815D); {'ü'}
'▀': PokeChar2($E17E); {'ß'}
' ': PokeKey($5B20); {Vollcursor mit Shift}
#27: PokeKey($1B03); {Escape=BRK/ESC - unter Win9x ESC mit VK_Esc.}
#8: PokeKey($0F01); {Backspace=CLR/HCOPY}
#9: PokeKey($1716); {TAB als Shiftlock-Taste mißbrauchen}
'A'..'Z': PokeChar(Char(wParam+$20));
'a'..'z': PokeChar(Char(wParam-$20));
else PokeChar(Char(wParam));{auch: Enter}
end;
WM_DropFiles: begin
for I:=0 to Integer(DragQueryFile(wParam,$FFFF,nil,0))-1 do begin
DragQueryFile(wParam,I,S,sizeof(S));
LoadFile(S,0,false);
end;
DragFinish(wParam);
end;
WM_LButtonDown: begin
if wParam and MK_RButton <>0
then SendMessage(Wnd,WM_Paste,0,0) {Einfügen (wie bei X und OS/2)}
else begin
RemoveAnySelection; {Selektion weg vom Bildschirm}
pt.x:=Pix2ChrBoxX(pt.x);
pt.y:=Pix2ChrBoxY(pt.y);
SetRect(SelectedRect,pt.x,pt.y,pt.x,pt.y);
SetCapture(Wnd); {Mausereignisse GLOBAL abfangen}
end;
end;
WM_MouseMove: if GetCapture=Wnd
then MouseDrag(pt.x,pt.y);
WM_LButtonUp: if GetCapture=Wnd
then ReleaseCapture; {Globale Mausereignisse abschalten}
WM_RButtonDown: begin
if wParam and MK_LButton <>0
then SendMessage(Wnd,WM_Copy,0,0) {Kopieren (wie bei X und OS/2)}
else begin
MouseX:=Pix2ChrBoxX(pt.x); {merken zum Rand setzen}
W:=LoadMenu(Seg(HInstance),MakeIntResource(304));
GetMenuString(W,903,S,sizeof(S),MF_ByCommand); {"Hilfe zu: "}
Keyword[0]:=#0;
CallEvent(KCEV_GetKeyword,MouseX+(Pix2ChrBoxY(pt.y) shl 8),
LongInt(@Keyword));
if Keyword[0]<>#0 then begin {Schlüsselwort gefunden}
lstrcat(S,Keyword);
ModifyMenu(W,903,MF_String or MF_ByCommand,903,S);
end else DeleteMenu(W,903,MF_ByCommand);
ClientToScreen(Wnd,pt);
if RandL>=RandR then CheckMenuItem(W,162,MF_Checked);
TrackPopupMenu(GetSubMenu(W,0),TPM_LeftAlign or TPM_RightButton,
pt.x,pt.y,0,Wnd,nil);
DestroyMenu(W);
end;
end;
WM_InitMenuPopup: case GetMenuItemID(wParam,0) of
1001: FillMenuWithHelpfiles(wParam);
211: FillMenuWithUserKCs(wParam);
101: begin
W:=MF_Grayed;
if IsClipboardFormatAvailable(CF_Text) then W:=MF_Enabled;
EnableMenuItem(wParam,153,W);
end;
end;
WM_MenuSelect: if LineDrawn {vert. Hilfslinie zeichnen/löschen}
xor (((wParam=160) or (wParam=161)) and (lPar.Hi<>0))
then begin {flüchtige Linie zeichnen, beim Schließen des Popup-Menüs
entfernt sie sich wieder, weil Windows WM_MenuSelect lPar.Hi=0 setzt}
PS.hDC:=GetDC(Wnd);
DrawRandLinie(PS.hDC); {Linie zeichnen/löschen}
ReleaseDC(Wnd,PS.hDC);
LineDrawn:=not LineDrawn;
end;
WM_Timer: case wParam of
1: begin
Foreground:=not Foreground;
Animate;
end;
2: begin
KillTimer(Wnd,2);
if KCTyp=0 then begin
{ W:=GetSubMenu(GetSubMenu(GetMenu(Wnd),2),9);
pt.x:=160; pt.y:=20; ClientToScreen(Wnd,pt);
TrackPopupMenu(W,TPM_CenterAlign,pt.x,pt.y,0,Wnd,nil);}
{Menü für KC-Typauswahl automatisch ausklappen, um Neulinge
mit der Nase draufstoßen zu lassen}
PostMessage(Wnd,WM_SysCommand,SC_KeyMenu,LongInt('O'));
PostMessage(Wnd,WM_KeyDown,Word('C'),$102E0001);
end else if lstrlen(CmdLine)<>0
then LoadFile(CmdLine,0,false);
end;
end;
WM_EndSession: if (wParam<>0) and Installed then SaveConfig;
WM_Close: begin
if Installed then SaveConfig;
WinHelp(Wnd,HelpFile,HELP_Quit,0);
if hWav<>0 then WaveOutClose(hWav);
if WaveOption=3 then asm
in al,61h
and al,not 3
out 61h,al {Sound ausschalten}
end;
WaveOption:=0; {damit Sound nicht wieder eingeschaltet wird}
PostQuitMessage(0);
end;
WM_Destroy: begin
SetNewKC(0);
PageFree(MemKCSel);
DeleteObject(hPal);
SetWinGUse(false);
end;
MM_WOM_Open: begin {Öffnen, wParam=Handle, lParam=ungenutzt}
CurWaveHdr:=MakeWaveBlock(Waves[0]);
NextWaveHdr:=MakeWaveBlock(Waves[1]);
end;
MM_WOM_Done: begin {Daten vorhanden! wParam=Handle, lParam=pWaveHdr}
If CurWaveHdr=nil then CurWaveHdr:=Pointer(lParam)
else NextWaveHdr:=Pointer(lParam);
end;
MM_WOM_Close: begin
FreeWaveBlock(wParam,Waves[0]);
FreeWaveBlock(wParam,Waves[1]);
SetSound(true);
end;
else CallOld:=true;
end;
if CallOld then KCWndProc:=DefWindowProc(Wnd,Msg,wParam,lParam);
end;
{Unter Windows95 wird das VxD ggf. dynamisch ge- und entladen}
const
KCEMU_Device_ID=$3E69;
const
VxDName:array[0..9] of Char='KCEMU.386';
var
VXDLDR_Entry:Pointer;
OldExit:Pointer;
procedure NewExit; far; assembler;
asm
db $66
mov ax,word ptr [OldExit]
db $66
mov word ptr [ExitProc],ax
mov ax,$0002 {Unload_VxD}
mov bx,KCEMU_Device_ID
call [VXDLDR_Entry]
end;
procedure GetKCEmuVxDEntry; assembler;
asm xor di,di
mov es,di
mov bx,KCEMU_Device_ID
mov ax,$1684 {Get Device API Entry Point}
int $2F
mov ax,es
mov word ptr [KCEmuVxDEntry],di
mov word ptr [KCEmuVxDEntry+2],ax
end;
procedure FindKCEmuVxD; assembler;
asm call GetKCEmuVxDEntry
or ax,ax {<>0?}
jnz @@e {ja, statisch geladen!}
mov bx,$0027 {VXDLDR-Device-ID}
mov ax,$1684
int $2F
mov ax,es
or ax,ax {<>0?}
jz @@e {nein, wohl kein Windows95?}
mov word ptr [VXDLDR_Entry],di
mov word ptr [VXDLDR_Entry+2],ax
mov dx,offset VxDName
mov ax,$0001 {Load_VxD}
call [VXDLDR_Entry]
jc @@e {Fehler!}
push cs
push offset NewExit
db $66
pop ax
db $66
xchg word ptr [ExitProc],ax
db $66
mov word ptr [OldExit],ax
call GetKCEmuVxDEntry {Zweiter Versuch}
@@e: end;
const
wc: TWndClass=( {Hauptfenster}
style: CS_ByteAlignClient or CS_DblClks or CS_HRedraw or CS_VRedraw;
lpfnWndProc: @KCWndProc;
cbClsExtra: 0;
cbWndExtra: 0;
hInstance: Seg(HInstance);
hIcon: 0;
hCursor: 0;
hbrBackground: 0; {kein Hintergrund!}
lpszMenuName: MakeIntResource(100);
lpszClassName: 'KCEMU');
wc2: TWndClass=( {Debug-Listenfenster ASM, MEM und STACK}
style: CS_ParentDC or CS_DblClks;
lpfnWndProc: @DebugListProc;
cbClsExtra: 0;
cbWndExtra: 2; {speichert alle zusätzlichen Daten dynamisch}
hInstance: Seg(HInstance);
hIcon: 0;
hCursor: 0;
hbrBackground: 0;
lpszMenuName: nil;
lpszClassName: 'KCDEB');
var
Msg: TMsg;
hAccel: THandle;
begin
if HPrevInst=0 then begin
wc.hIcon:=LoadIcon(Seg(HInstance),MakeIntResource(100));
wc.hCursor:=LoadCursor(0,IDC_Arrow);
RegisterClass(wc);
wc2.hCursor:=wc.hCursor;
RegisterClass(wc2);
end;
FindKCEmuVxD;
hAccel:=LoadAccelerators(Seg(HInstance),MakeIntResource(100));
LoadString(Seg(HInstance),100,AppName,sizeof(AppName));
StdMBoxTitle:=AppName;
Saum.x:=2*GetSystemMetrics(SM_CXBorder);
Saum.y:=2*GetSystemMetrics(SM_CYBorder)
+GetSystemMetrics(SM_CYCaption)+GetSystemMetrics(SM_CYMenu);
EmuBlock:=$10; {Blockiert durch F9}
CurWaveHdr:=nil;NextWaveHdr:=nil; {keine Puffer verfügbar}
MainWnd:=CreateWindowEx(WS_EX_AcceptFiles,'KCEMU',AppName,
WS_Border or WS_Caption or WS_MinimizeBox or WS_MaximizeBox
or WS_Overlapped or WS_SysMenu,
CW_UseDefault,CW_UseDefault,
KCPixmap.x+Saum.x,KCPixmap.y+Saum.y,
0,0,Seg(HInstance),nil);
if MainWnd=0 then RunError(223);
ShowWindow(MainWnd,CmdShow);
repeat
if PeekMessage(Msg,0,0,0,PM_Remove) then begin
if Msg.message=WM_Quit then break;
if (hAccel<>0) and (TranslateAccelerator(MainWnd,hAccel,Msg)<>0)
then continue;
if (hKBWnd<>0) and IsDialogMessage(hKBWnd,Msg) then continue;
TranslateMessage(Msg);
DispatchMessage(Msg);
continue;
end;
if not IdleAction then WaitMessage;
until false;
Halt(Msg.wParam);
end.
| Detected encoding: OEM (CP437) | 1
|
|
|
![[Download]](icons/dl.gif){kind=icon}
kcemu_052.exe/SRC/KCEMU.PAS