procedure setp(start, endpos: integer; rgb: TBytes);
procedure putfont8(vram: TBytes; xsize, x, y: integer; c: Int8;
font: TBytes);
- procedure putfont8_asc(vram: TBytes; xsize, x, y: integer; c: Int8;
- s: UInt8);
+ procedure putfonts8_asc(vram: TBytes; xsize, x, y: integer; c: Int8;
+ s: PAnsiChar);
procedure mouse_cursor8(mouse: TBytes; bc: Int8);
end;
function Status(var fifo: TFIFO8): integer;
end;
- TKeyboard = class
+ TDevice = class
const
PORT_KEYDAT = $0060;
PORT_KEYSTA = $0064;
KEYSTA_SEND_NOTREADY = $02;
KEYCMD_WRITE_MODE = $60;
KBC_MODE = $47;
- private
+ protected
procedure wait_KBC_sendready;
public
- fifo: TFIFO8;
- keyfifo: TFifo;
+ fifo8: TFIFO8;
+ fifo: TFifo;
constructor Create;
destructor Destroy; override;
- procedure Init;
- procedure inthandler21(var esp: integer);
+ procedure Init; virtual; abstract;
+ procedure inthandler21(var esp: integer); virtual; abstract;
+ end;
+
+ TKeyboard = class(TDevice)
+ public
+ procedure Init; override;
+ procedure inthandler21(var esp: integer); override;
+ end;
+
+ TMOUSE_DEC = record
+ buf: array [0 .. 2] of Byte;
+ phase: Byte;
+ x, y, btn: integer;
+ end;
+
+ TMouse = class(TDevice)
+ const
+ KEYCMD_SENDTO_MOUSE = $D4;
+ MOUSECMD_ENABLE = $F4;
+ public
+ procedure enable_mouse(DEC: TMOUSE_DEC);
+ function decode(DEC: TMOUSE_DEC; dat: UInt8): integer;
+ procedure inthandler21(var esp: integer); override;
end;
TMemtest = class
PIC1_ICW3 = $00A1;
PIC1_ICW4 = $00A1;
- COL8_000000 = 0;
+ COL8_000000: Int8 = 0;
COL8_FF0000 = 1;
COL8_00FF00 = 2;
COL8_FFFF00 = 3;
COL8_008484 = 14;
COL8_848484 = 15;
- ADR_BOOTINFO = $00000ff0;
+ ADR_BOOTINFO = $00000FF0;
implementation
inc(fifo.p);
if fifo.p = fifo.size then
fifo.p := 0;
- dec(fifo.free);
+ DEC(fifo.free);
result := 0;
end;
result := fifo.size - fifo.free;
end;
-{ TKeyboard }
-
-constructor TKeyboard.Create;
-begin
- inherited;
- keyfifo := TFifo.Create;
-end;
-
-destructor TKeyboard.Destroy;
-begin
- keyfifo.free;
- inherited;
-end;
-
-procedure TKeyboard.Init;
-begin
- wait_KBC_sendready;
- io_out8(PORT_KEYCMD, KEYCMD_WRITE_MODE);
- wait_KBC_sendready;
- io_out8(PORT_KEYDAT, KBC_MODE)
-end;
-
-procedure TKeyboard.inthandler21(var esp: integer);
-var
- i: UInt8;
-begin
- io_out8(PIC0_OCW2, $61);
- i := io_in8(PORT_KEYDAT);
- keyfifo.Put(fifo, i);
-end;
-
-procedure TKeyboard.wait_KBC_sendready;
-begin
- while True do
- if io_in8(PORT_KEYSTA) and KEYSTA_SEND_NOTREADY = 0 then
- break;
-end;
-
{ TMemtest }
function TMemtest.memtest(start, endpos: Cardinal): Cardinal;
s := mem.free[i];
result := s.addr;
inc(s.addr, size);
- dec(s.size, size);
+ DEC(s.size, size);
if s.size = 0 then
mem.free.delete(i)
else
end;
end;
-procedure TPallet.putfont8_asc(vram: TBytes; xsize, x, y: integer; c: Int8;
- s: UInt8);
+procedure TPallet.putfonts8_asc(vram: TBytes; xsize, x, y: integer; c: Int8;
+ s: PAnsiChar);
var
hankaku: TBytes;
begin
- while s <> $00 do
+ while Byte(s[0]) <> $00 do
begin
- putfont8(vram, xsize, x, y, c, @hankaku[s * 16]);
+ putfont8(vram, xsize, x, y, c, @hankaku[Byte(s) * 16]);
inc(s);
inc(x, 8);
end;
boxfill8(vram, x, COL8_FFFFFF, x - 3, y - 24, x - 3, y - 3);
end;
+{ TMouse }
+
+function TMouse.decode(DEC: TMOUSE_DEC; dat: UInt8): integer;
+begin
+ result:=0;
+ case DEC.phase of
+ 0:
+ if dat = $FA then
+ DEC.phase := 1;
+ 1:
+ if (dat and $CB) = $08 then
+ begin
+ DEC.buf[0] := dat;
+ DEC.phase := 2;
+ end;
+ 2:
+ begin
+ DEC.buf[1] := dat;
+ DEC.phase := 3;
+ end;
+ 3:
+ begin
+ DEC.buf[2] := dat;
+ DEC.phase := 1;
+ DEC.btn := DEC.buf[0] and $07;
+ DEC.x := DEC.buf[1];
+ DEC.y := DEC.buf[2];
+ if (DEC.buf[0] and $10) <> 0 then
+ DEC.x := DEC.x or $FFFFFF00;
+ if (DEC.buf[0] and $20) <> 0 then
+ DEC.y := DEC.y or $FFFFFF00;
+ DEC.y := -DEC.y;
+ result:=1;
+ end;
+ else
+ result:=-1;
+ end;
+end;
+
+procedure TMouse.enable_mouse(DEC: TMOUSE_DEC);
+begin
+ wait_KBC_sendready;
+ io_out8(PORT_KEYCMD, KEYCMD_SENDTO_MOUSE);
+ wait_KBC_sendready;
+ io_out8(PORT_KEYDAT, MOUSECMD_ENABLE);
+ DEC.phase := 0;
+end;
+
+procedure TMouse.inthandler21(var esp: integer);
+var
+ i: integer;
+begin
+ io_out8(PIC1_OCW2, $64);
+ io_out8(PIC0_OCW2, $62);
+ i := io_in8(PORT_KEYDAT);
+ fifo.Put(fifo8, i);
+end;
+
+{ TDevice }
+
+constructor TDevice.Create;
+begin
+ inherited;
+ fifo := TFifo.Create;
+end;
+
+destructor TDevice.Destroy;
+begin
+ fifo.free;
+ inherited;
+end;
+
+procedure TDevice.wait_KBC_sendready;
+begin
+ while True do
+ if io_in8(PORT_KEYSTA) and KEYSTA_SEND_NOTREADY = 0 then
+ break;
+end;
+
+{ TKeyboard }
+
+procedure TKeyboard.Init;
+begin
+ wait_KBC_sendready;
+ io_out8(PORT_KEYCMD, KEYCMD_WRITE_MODE);
+ wait_KBC_sendready;
+ io_out8(PORT_KEYDAT, KBC_MODE)
+end;
+
+procedure TKeyboard.inthandler21(var esp: integer);
+var
+ i: UInt8;
+begin
+ io_out8(PIC0_OCW2, $61);
+ i := io_in8(PORT_KEYDAT);
+ fifo.Put(fifo8, i);
+end;
+
end.
uses
System.SysUtils,
+ System.Classes,
bootpack in 'bootpack.pas',
asmhead in 'asmhead.pas';
var
binfo: ^TBOOTINFO = Pointer(ADR_BOOTINFO);
screen: TScreen;
+ font: TPallet;
+ mousefifo: TMouse;
keyboard: TKeyboard;
- keybuf: TBytes;
i: SmallInt;
memtest: TMemtest;
memtotal: Cardinal;
mem: TMem;
sheet: TShtCtl;
mouse, win, back: integer;
+ s: string[40];
+ buf_win, buf_back, keybuf, buf_mouse: TBytes;
+ mx, my: integer;
-procedure window8(buf: array of Byte; xsize, ysize: integer; var title: string);
+procedure window8(buf: TBytes; xsize, ysize: integer; title: PAnsiChar);
const
- closebtn: array [0 .. 14, 0 .. 15] of Char = (('0', '0', '0', '0', '0', '0',
- '0', '0', '0', '0', '0', '0', '0', '0', '0', '@'),
- ('0', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q', '$',
- '@'), ('0', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q',
- '$', '@'), ('0', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q',
- 'Q', '$', '@'), ('0', 'Q', 'Q', 'Q', '@', '@', 'Q', 'Q', 'Q', 'Q', '@', '@',
- 'Q', 'Q', '$', '@'), ('0', 'Q', 'Q', 'Q', 'Q', '@', '@', 'Q', 'Q', '@', '@',
- 'Q', 'Q', 'Q', '$', '@'), ('0', 'Q', 'Q', 'Q', 'Q', 'Q', '@', '@', '@', '@',
- 'Q', 'Q', 'Q', 'Q', '$', '@'), ('0', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q', '@', '@',
- 'Q', 'Q', 'Q', 'Q', 'Q', '$', '@'), ('0', 'Q', 'Q', 'Q', 'Q', 'Q', '@', '@',
- '@', '@', 'Q', 'Q', 'Q', 'Q', '$', '@'), ('0', 'Q', 'Q', 'Q', 'Q', '@', '@',
- 'Q', 'Q', '@', '@', 'Q', 'Q', 'Q', '$', '@'), ('0', 'Q', 'Q', 'Q', '@', '@',
- 'Q', 'Q', 'Q', 'Q', '@', '@', 'Q', 'Q', '$', '@'),
- ('0', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q', '$',
- '@'), ('0', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q', 'Q',
- '$', '@'), ('0', '$', '$', '$', '$', '$', '$', '$', '$', '$', '$', '$', '$',
- '$', '$', '@'), ('@', '@', '@', '@', '@', '@', '@', '@', '@', '@', '@', '@',
- '@', '@', '@', '@'));
-begin
-
-end;
-
+ closebtn: array [0 .. 14] of string[16] = ( //
+ ('000000000000000@'), //
+ ('0QQQQQQQQQQQQQ$@'), //
+ ('0QQQQQQQQQQQQQ$@'), //
+ ('0QQQQQQQQQQQQQ$@'), //
+ ('0QQQ@@QQQQ@@QQ$@'), //
+ ('0QQQQ@@QQ@@QQQ$@'), //
+ ('0QQQQQ@@@@QQQQ$@'), //
+ ('0QQQQQQ@@QQQQQ$@'), //
+ ('0QQQQQ@@@@QQQQ$@'), //
+ ('00QQQ@@QQ@@QQQ$@'), //
+ ('0QQQ@@QQQQ@@QQ$@'), //
+ ('0QQQQQQQQQQQQQ$@'), //
+ ('0QQQQQQQQQQQQQ$@'), //
+ ('0$$$$$$$$$$$$$$@'), //
+ ('@@@@@@@@@@@@@@@@') //
+ );
+var
+ y: integer;
+ x: integer;
+ c: AnsiChar;
+ i: Byte;
begin
- screen:=TScreen.Create;
- screen.Init(binfo^.vram,binfo^.scrnx,binfo^.scrny);
- keyboard := TKeyboard.Create;
- SetLength(keybuf, 32);
- with keyboard do
+ with screen do
begin
- keyfifo.Init(fifo, 32, keybuf);
- while True do
+ boxfill8(buf, xsize, COL8_C6C6C6, 0, 0, xsize - 1, 0);
+ boxfill8(buf, xsize, COL8_FFFFFF, 1, 1, xsize - 2, 1);
+ boxfill8(buf, xsize, COL8_C6C6C6, 0, 0, 0, ysize - 1);
+ boxfill8(buf, xsize, COL8_FFFFFF, 1, 1, 1, ysize - 2);
+ boxfill8(buf, xsize, COL8_848484, xsize - 2, 1, xsize - 2, ysize - 2);
+ boxfill8(buf, xsize, COL8_000000, xsize - 1, 0, xsize - 1, ysize - 1);
+ boxfill8(buf, xsize, COL8_C6C6C6, 2, 2, xsize - 3, ysize - 3);
+ boxfill8(buf, xsize, COL8_000084, 3, 3, xsize - 4, 20);
+ boxfill8(buf, xsize, COL8_848484, 1, ysize - 2, xsize - 2, ysize - 2);
+ boxfill8(buf, xsize, COL8_000000, 0, ysize - 1, xsize - 1, ysize - 1);
+ end;
+ font.putfonts8_asc(buf, xsize, 24, 4, COL8_FFFFFF, title);
+ for y := 0 to 14 do
+ for x := 1 to 16 do
begin
- io_cli;
- if keyfifo.Status(fifo) = 0 then
- // ioshift()
+ c := closebtn[y][x];
+ case c of
+ '@':
+ i := COL8_000000;
+ '$':
+ i := COL8_848484;
+ '0':
+ i := COL8_C6C6C6;
else
- begin
- i := keyfifo.Get(fifo);
- io_sti;
- // sprintf
- // boxfill8
- // putfonts8
+ i := COL8_FFFFFF;
end;
+ buf[(5 + y) * xsize + (xsize - 21 + x)] := i;
end;
- end;
+end;
+
+begin
+ screen := TScreen.Create;
+ screen.Init(binfo^.vram, binfo^.scrnx, binfo^.scrny);
+ keyboard := TKeyboard.Create;
+ mousefifo := TMouse.Create;
{
memtest:=TMemtest.Create;
memtotal:=memtest.memtest($00400000,$bfffffff);
mem.Free;
memtest.Free;
}
+ font := TPallet.Create;
sheet := TShtCtl.Create;
back := sheet.allock;
mouse := sheet.allock;
win := sheet.allock;
sheet.slide(mouse, 10, 10);
sheet.slide(win, 80, 72);
+ SetLength(buf_win, 160 * 68);
+ SetLength(keybuf, 32);
+ SetLength(buf_mouse, 128);
+ sheet.setbuf(back, buf_back, binfo^.scrnx, binfo^.scrny, -1);
+ sheet.setbuf(mouse, buf_mouse, 16, 16, 99);
+ sheet.setbuf(win, buf_win, 160, 68, -1);
+ font.mouse_cursor8(buf_mouse, 99);
+ window8(buf_win, 160, 68, 'window');
+ font.putfonts8_asc(buf_win, 160, 24, 28, COL8_000000, 'Welcom to');
+ font.putfonts8_asc(buf_win, 160, 24, 44, COL8_000000, 'Haribote-XE');
+ mx := (binfo^.scrnx - 16) div 2;
+ my := (binfo^.scrny - 28 - 16) div 2;
+ sheet.slide(mouse, mx, my);
+ sheet.slide(win, 80, 72);
+ sheet.updown(back, 0);
+ sheet.updown(mouse, 1);
+ sheet.updown(win, 2);
+ // sprintf
+ font.putfonts8_asc(binfo^.vram, 0, 32, COL8_FFFFFF, s);
+ sheet.refresh(Rect(0, 0, 80, 16));
+ mousefifo.Init(mousefifo.fifo8, 128, buf_mouse);
+ keyboard.Init(keyboard.fifo8, 32, keybuf);
+ while True do
+ begin
+ io_cli;
+ if keyboard.fifo.Status(keyboard.fifo8) + mousefifo.fifo.Status
+ (mousefifo.fifo8) = 0 then
+ io_stihlt
+ else
+ begin
+ if keyboard.fifo.Status(keyboard.fifo8) <> 0 then
+ begin
+ i := keyboard.fifo.Get(keyboard.fifo8);
+ io_sti;
+ // sprintf
+ screen.boxfill8(buf_back, binfo^.scrnx, COL8_008484, 0, 16, 15, 31);
+ font.putfonts8_asc(buf_back, binfo^.scrnx, 0, 16, COL8_FFFFFF, s);
+ sheet.refresh(Rect(0, 16, 16, 32));
+ end
+ else if mousefifo.fifo.Status(mousefifo.fifo8) <> 0 then
+ begin
+ i := mousefifo.fifo.Get(mousefifo.fifo8);
+ io_sti;
+ sheet.refresh(Rect(0, 0, 80, 16));
+ end;
+ end;
+ end;
+ font.Free;
sheet.Free;
keyboard.Free;
+ mousefifo.Free;
+ Finalize(keybuf);
screen.Free;
+
end.
OSDN Git Service
