DSKCAC: UInt32 = $00100000;
DSKCAC0: UInt32 = $00008000;
- CYLS: UInt16 = $0ff0;
- LEDS: UInt16 = $0ff1;
- VMODE: UInt16 = $0ff2;
- SCRNX: UInt16 = $0ff4;
- SCRNY: UInt16 = $0ff6;
- VRAM: UInt16 = $0ff8;
+ CYLS: UInt16 = $0FF0;
+ LEDS: UInt16 = $0FF1;
+ VMODE: UInt16 = $0FF2;
+ SCRNX: UInt16 = $0FF4;
+ SCRNY: UInt16 = $0FF6;
+ VRAM: UInt16 = $0FF8;
asm
// ORG
@skip:
MOV ESP,[EBX+12]
- //JMP DWORD PTR 2*8:$0000001b
+ // JMP DWORD PTR 2*8:$0000001b
@waitkbdout:
IN AL,$64
class procedure TAsmhead.Init;
const
CYLS: UInt32 = 10;
-asm
+ asm
end;
interface
uses
- System.Classes, System.Generics.Collections, System.SysUtils, System.Types;
+ System.Classes, System.Generics.Collections, System.SysUtils, System.Types,
+ graphic;
type
TBOOTINFO = record
vram: TBytes;
end;
- TPallet = class
- public
- hankaku: TResourceStream;
- constructor Create;
- destructor Destroy; override;
- procedure Init;
- procedure setp(start, endpos: integer; rgb: TBytes);
- procedure putfont8(vram: TBytes; xsize, x, y: integer; c: Int8;
- font: TBytes);
- procedure putfonts8_asc(vram: TBytes; xsize, x, y: integer; c: Int8;
- s: string);
- procedure mouse_cursor8(mouse: TBytes; bc: Int8);
- end;
-
- TScreen = class
- public
- constructor Create(vram: TBytes; x, y: integer);
- procedure boxfill8(vram: TBytes; xsize: integer; c: UInt8;
- x0, y0, x1, y1: integer);
- end;
-
TFIFO8 = record
- buf: TBytes;
+ buf: array of UInt32;
p, q, size, free, flags: integer;
end;
private
fifo: TFIFO8;
public
- constructor Create(size: integer; buf: TBytes);
+ constructor Create(size: integer);
+ destructor Destroy; override;
function Put(data: Byte): integer;
function Get: SmallInt;
function Status: integer;
end;
- TDevice = class(TFifo)
+ TDevice = class
const
PORT_KEYDAT = $0060;
PORT_KEYSTA = $0064;
KEYSTA_SEND_NOTREADY = $02;
KEYCMD_WRITE_MODE = $60;
KBC_MODE = $47;
- protected
+ private
+ fifo: TFifo;
+ buf: array [0 .. 255] of Byte;
procedure wait_KBC_sendready;
public
procedure inthandler21(var esp: integer); virtual; abstract;
end;
TKeyboard = class(TDevice)
+ private
+ keydata: integer;
public
- constructor Create(size: integer; buf: TBytes);
+ constructor Create(fifo: TFifo; data0: integer);
procedure inthandler21(var esp: integer); override;
end;
const
KEYCMD_SENDTO_MOUSE = $D4;
MOUSECMD_ENABLE = $F4;
+ private
+ mousedata: integer;
public
dec: TMOUSE_DEC;
- procedure enable_mouse;
+ constructor Create(fifo: TFifo; data0: integer);
function decode(dat: UInt8): integer;
procedure inthandler21(var esp: integer); override;
end;
function memfree(mem: TMEMMAN; addr, size: Cardinal): integer;
end;
- TSHEET = record
- buf: TBytes;
- bxsize, bysize, vx0, vy0, col_inv, flags: integer;
- visible: Boolean;
- end;
-
- TShtCtl = class
- public
- vram: TBytes;
- xsize, ysize: integer;
- sheets: TList<TSHEET>;
- constructor Create;
- destructor Destroy; override;
- procedure Init(mem: TMEMMAN; x, y: integer);
- function allock: integer;
- procedure setbuf(index: integer; buffer: TBytes;
- xsize, ysize, col_inv: integer);
- procedure updown(index, height: integer);
- procedure refresh(rect: TRect);
- procedure slide(index, x, y: integer);
- procedure delete(index: integer);
- end;
-
const
FLAGSOVERRUN = $0001;
PIC1_ICW3 = $00A1;
PIC1_ICW4 = $00A1;
- COL8_000000: Int8 = 0;
- COL8_FF0000 = 1;
- COL8_00FF00 = 2;
- COL8_FFFF00 = 3;
- COL8_0000FF = 4;
- COL8_FF00FF = 5;
- COL8_00FFFF = 6;
- COL8_FFFFFF = 7;
- COL8_C6C6C6 = 8;
- COL8_840000 = 9;
- COL8_008400 = 10;
- COL8_848400 = 11;
- COL8_000084 = 12;
- COL8_840084 = 13;
- COL8_008484 = 14;
- COL8_848484 = 15;
-
ADR_BOOTINFO = $00000FF0;
implementation
uses asmhead;
+destructor TFifo.Destroy;
+begin
+ Finalize(fifo.buf);
+ inherited;
+end;
+
function TFifo.Get: SmallInt;
begin
if fifo.free = fifo.size then
inc(fifo.free);
end;
-constructor TFifo.Create(size: integer; buf: TBytes);
+constructor TFifo.Create(size: integer);
begin
inherited Create;
- SetLength(buf,size);
+ SetLength(fifo.buf, size);
fifo.size := size;
- fifo.buf := buf;
fifo.free := size;
fifo.flags := 0;
fifo.p := 0;
eflg := eflg or EFLAGS_AC_BIT;
io_store_eflags(eflg);
eflg := io_load_eflags();
- if eflg and EFLAGS_AC_BIT <> 0 then
+ if (eflg and EFLAGS_AC_BIT) <> 0 then
flag486 := 1;
eflg := eflg and EFLAGS_AC_BIT;
io_store_eflags(eflg);
var
i, old: UInt32;
p: ^UInt32;
-label not_memory;
begin
i := start;
while i <= endpos do
p^ := p^ XOR $FFFFFFFF;
if p^ <> pat1 then
begin
- not_memory:
p^ := old;
break;
end;
p^ := p^ XOR $FFFFFFFF;
if p^ <> pat0 then
- goto not_memory;
+ begin
+ p^ := old;
+ break;
+ end;
p^ := old;
inc(i, $1000);
end;
inherited;
end;
-{ TShtCtl }
-
-constructor TShtCtl.Create;
-begin
- sheets := TList<TSHEET>.Create;
-end;
-
-procedure TShtCtl.delete(index: integer);
-begin
- sheets.delete(index);
-end;
-
-destructor TShtCtl.Destroy;
-begin
- sheets.free;
- inherited;
-end;
-
-function TShtCtl.allock: integer;
-const
- SHEET_USE = 1;
-var
- s: TSHEET;
-begin
- s.flags := SHEET_USE;
- s.visible := True;
- result := sheets.Add(s);
-end;
-
-procedure TShtCtl.Init(mem: TMEMMAN; x, y: integer);
-begin
- xsize := x;
- ysize := y;
- sheets.Clear;
-end;
-
-procedure TShtCtl.refresh(rect: TRect);
-var
- i: integer;
- x: integer;
- y: integer;
- vx, vy: integer;
- c: Byte;
- clip: TRect;
-begin
- if rect.Left < 0 then
- rect.Left := 0;
- if rect.Right >= xsize then
- rect.Right := xsize;
- if rect.Top < 0 then
- rect.Top := 0;
- if rect.Bottom >= ysize then
- rect.Bottom := ysize;
- for i := 0 to sheets.Count - 1 do
- with sheets[i] do
- begin
- clip.Left := rect.Left - vx0;
- clip.Right := rect.Right - vx0;
- clip.Top := rect.Top - vy0;
- clip.Bottom := rect.Bottom - vy0;
- if clip.Left < 0 then
- clip.Left := 0;
- if clip.Right > bxsize then
- clip.Right := bxsize;
- if clip.Top < 0 then
- clip.Top := 0;
- if clip.Bottom > bysize then
- clip.Bottom := bysize;
- for y := clip.Top to clip.Bottom - 1 do
- begin
- vy := vy0 + y;
- for x := clip.Left to clip.Right - 1 do
- begin
- vx := vx0 + x;
- c := buf[y * bxsize + x];
- if c <> col_inv then
- vram[vy * xsize + vx] := c;
- end;
- end;
- end;
-end;
-
-procedure TShtCtl.setbuf(index: integer; buffer: TBytes;
- xsize, ysize, col_inv: integer);
-var
- s: TSHEET;
-begin
- s.buf := buffer;
- s.bxsize := xsize;
- s.bysize := ysize;
- s.col_inv := col_inv;
- sheets[index] := s;
-end;
-
-procedure TShtCtl.slide(index, x, y: integer);
-var
- i, j: integer;
- p: ^TSHEET;
-begin
- p := TList(sheets)[index];
- with p^ do
- begin
- i := vx0;
- j := vy0;
- vx0 := x;
- vy0 := y;
- if visible = True then
- begin
- refresh(rect(i, j, i + bxsize, j + bysize));
- refresh(rect(x, y, x + bxsize, y + bysize));
- end;
- end;
-end;
-
-procedure TShtCtl.updown(index, height: integer);
-var
- p: ^TSHEET;
-begin
- if height >= sheets.Count then
- height := sheets.Count - 1;
- if height < -1 then
- height := -1;
- if height >= 0 then
- begin
- sheets.Move(index, height);
- if sheets[height].visible = false then
- begin
- p := TList(sheets)[height];
- p^.visible := True;
- end;
- end
- else
- begin
- p := TList(sheets)[index];
- p^.visible := false;
- end;
-end;
-
-{ TPallet }
-
-constructor TPallet.Create;
-begin
- inherited;
- hankaku := TResourceStream.Create(HInstance, 'hankaku', RT_RCDATA);
-end;
-
-destructor TPallet.Destroy;
-begin
- hankaku.free;
- inherited;
-end;
-
-procedure TPallet.Init;
-const
- table: array [0 .. 14, 0 .. 2] of Byte = (($00, $00, $00), ($FF, $00, $00),
- ($00, $FF, $00), ($FF, $FF, $00), ($00, $00, $FF), ($FF, $00, $FF),
- ($00, $FF, $FF), ($C6, $C6, $C6), ($84, $00, $00), ($00, $84, $00),
- ($84, $84, $00), ($00, $00, $84), ($84, $00, $84), ($00, $84, $84),
- ($84, $84, $84));
-begin
- setp(0, 15, TBytes(@table));
-end;
-
-procedure TPallet.mouse_cursor8(mouse: TBytes; bc: Int8);
-const
- cursor: array [0 .. 15] of string[16] = ( //
- ('**************..'), //
- ('*00000000000*...'), //
- ('*0000000000*....'), //
- ('*000000000*.....'), //
- ('*00000000*......'), //
- ('*0000000*.......'), //
- ('*0000000*.......'), //
- ('*00000000*......'), //
- ('*0000**000*.....'), //
- ('*000*..*000*....'), //
- ('*00*....*000*...'), //
- ('*0*......*000*..'), //
- ('**........*000*.'), //
- ('*..........*000*'), //
- ('............*00*'), //
- ('.............***') //
- );
-var
- x: integer;
- y: integer;
-begin
- for y := 0 to 15 do
- for x := 0 to 15 do
- case cursor[y][x] of // x , y ?
- '*':
- mouse[y * 16 + x] := COL8_000000;
- '0':
- mouse[y * 16 + x] := COL8_FFFFFF;
- '.':
- mouse[y * 16 + x] := bc;
- end;
-end;
-
-procedure TPallet.putfont8(vram: TBytes; xsize, x, y: integer; c: Int8;
- font: TBytes);
-var
- i: integer;
- p: TBytes;
- d: Byte;
-begin
- for i := 0 to 16 do
- begin
- p := TBytes(@vram[(y + i) * xsize + x]);
- d := font[i];
- if d and $80 <> 0 then
- p[0] := c;
- if d and $40 <> 0 then
- p[1] := c;
- if d and $20 <> 0 then
- p[2] := c;
- if d and $10 <> 0 then
- p[3] := c;
- if d and $08 <> 0 then
- p[4] := c;
- if d and $04 <> 0 then
- p[5] := c;
- if d and $02 <> 0 then
- p[6] := c;
- if d and $01 <> 0 then
- p[7] := c;
- end;
-end;
-
-procedure TPallet.putfonts8_asc(vram: TBytes; xsize, x, y: integer; c: Int8;
- s: string);
-var
- i: integer;
- buf: array [0 .. 15] of Byte;
-begin
- s := LowerCase(s);
- for i := 1 to Length(s) do
- begin
- hankaku.Write(TBytes(@buf), Ord(s[i]), 16);
- putfont8(vram, xsize, x, y, c, TBytes(@buf));
- inc(x, 8);
- end;
-end;
-
-procedure TPallet.setp(start, endpos: integer; rgb: TBytes);
-var
- eflags: integer;
- i, j: integer;
-begin
- eflags := io_load_eflags;
- io_cli;
- io_out8($03C8, start);
- j := 0;
- for i := start to endpos - 1 do
- begin
- io_out8($03C9, rgb[j + 0] div 4);
- io_out8($03C9, rgb[j + 1] div 4);
- io_out8($03C9, rgb[j + 2] div 4);
- inc(j, 3);
- end;
- io_store_eflags(eflags);
-end;
-
-{ TScreen }
-
-procedure TScreen.boxfill8(vram: TBytes; xsize: integer; c: UInt8;
- x0, y0, x1, y1: integer);
-var
- y: integer;
- x: integer;
-begin
- for y := y0 to y1 do
- for x := x0 to x1 do
- vram[y * xsize + x] := c;
-end;
+{ TMouse }
-constructor TScreen.Create(vram: TBytes; x, y: integer);
+constructor TMouse.Create(fifo: TFifo; data0: integer);
begin
inherited Create;
- boxfill8(vram, x, COL8_008484, 0, 0, x - 1, y - 29);
- boxfill8(vram, x, COL8_C6C6C6, 0, y - 28, x - 1, y - 28);
- boxfill8(vram, x, COL8_FFFFFF, 0, y - 27, x - 1, y - 27);
- boxfill8(vram, x, COL8_C6C6C6, 0, y - 26, x - 1, y - 1);
-
- boxfill8(vram, x, COL8_FFFFFF, 3, y - 24, 59, y - 24);
- boxfill8(vram, x, COL8_FFFFFF, 2, y - 24, 2, y - 4);
- boxfill8(vram, x, COL8_848484, 3, y - 4, 59, y - 4);
- boxfill8(vram, x, COL8_848484, 59, y - 23, 59, y - 5);
- boxfill8(vram, x, COL8_000000, 2, y - 3, 59, y - 3);
- boxfill8(vram, x, COL8_000000, 60, y - 24, 60, y - 3);
-
- boxfill8(vram, x, COL8_848484, x - 47, y - 24, x - 4, y - 24);
- boxfill8(vram, x, COL8_848484, x - 47, y - 23, x - 47, y - 4);
- boxfill8(vram, x, COL8_FFFFFF, x - 47, y - 3, x - 4, y - 3);
- boxfill8(vram, x, COL8_FFFFFF, x - 3, y - 24, x - 3, y - 3);
+ mousedata := data0;
+ Self.fifo := fifo;
+ wait_KBC_sendready();
+ io_out8(PORT_KEYCMD, KEYCMD_SENDTO_MOUSE);
+ wait_KBC_sendready();
+ io_out8(PORT_KEYDAT, MOUSECMD_ENABLE);
+ dec.phase := 0;
end;
-{ TMouse }
-
function TMouse.decode(dat: UInt8): integer;
begin
result := 0;
end;
end;
-procedure TMouse.enable_mouse;
-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;
io_out8(PIC1_OCW2, $64);
io_out8(PIC0_OCW2, $62);
i := io_in8(PORT_KEYDAT);
- Put(i);
+ fifo.Put(i + mousedata);
end;
{ TDevice }
{ TKeyboard }
-constructor TKeyboard.Create(size: integer; buf: TBytes);
+constructor TKeyboard.Create(fifo: TFifo; data0: integer);
begin
- inherited;
+ inherited Create;
+ Self.fifo := fifo;
+ keydata := data0;
wait_KBC_sendready;
io_out8(PORT_KEYCMD, KEYCMD_WRITE_MODE);
wait_KBC_sendready;
begin
io_out8(PIC0_OCW2, $61);
i := io_in8(PORT_KEYDAT);
- Put(i);
+ fifo.Put(i + keydata);
end;
end.
--- /dev/null
+unit graphic;
+
+interface
+
+uses System.Classes, System.SysUtils, System.Types;
+
+const
+ COL8_000000 = 0;
+ COL8_FF0000 = 1;
+ COL8_00FF00 = 2;
+ COL8_FFFF00 = 3;
+ COL8_0000FF = 4;
+ COL8_FF00FF = 5;
+ COL8_00FFFF = 6;
+ COL8_FFFFFF = 7;
+ COL8_C6C6C6 = 8;
+ COL8_840000 = 9;
+ COL8_008400 = 10;
+ COL8_848400 = 11;
+ COL8_000084 = 12;
+ COL8_840084 = 13;
+ COL8_008484 = 14;
+ COL8_848484 = 15;
+
+type
+ TSheet = class
+ private const
+ table: array [0 .. 14, 0 .. 2] of Byte = (($00, $00, $00), ($FF, $00, $00),
+ ($00, $FF, $00), ($FF, $FF, $00), ($00, $00, $FF), ($FF, $00, $FF),
+ ($00, $FF, $FF), ($C6, $C6, $C6), ($84, $00, $00), ($00, $84, $00),
+ ($84, $84, $00), ($00, $00, $84), ($84, $00, $84), ($00, $84, $84),
+ ($84, $84, $84));
+
+ var
+ vram: TBytes;
+ procedure putfont8(x, y: integer; c: Int8; font: PChar);
+ procedure putfonts8_asc(x, y: integer; c: Int8; s: string);
+ public
+ bxsize, bysize, vx0, vy0, col_inv, flags: integer;
+ visible: Boolean;
+ hankaku: TResourceStream;
+ refresh: Boolean;
+ clip: TRect;
+ constructor Create(x, y, act: integer);
+ destructor Destroy; override;
+ procedure boxfill8(c: UInt8; x0, y0, x1, y1: integer); overload;
+ procedure boxfill8(c: UInt8; rect: TRect); overload;
+ procedure setp(start, endpos: integer; rgb: TBytes);
+ procedure putfonts8_asc_sht(x, y: integer; font: string;
+ const back: integer = COL8_000000; const color: integer = COL8_FFFFFF);
+ end;
+
+ TCursor = class(TSheet)
+ public
+ constructor Create(x, y, act: integer);
+ end;
+
+ TScreen = class(TSheet)
+ public
+ constructor Create(x, y, act: integer);
+ end;
+
+ TWindow = class(TScreen)
+ private
+ procedure wintitl(title: string; act: integer);
+ public
+ constructor Create(xsize, ysize: integer; title: string; act: integer);
+ end;
+
+ TConsole = class(TWindow)
+ public
+ end;
+
+ TShtCtl = class
+ private const
+ SHEET_USE = 1;
+ procedure refreshmap(arect: TRect);
+ procedure refreshsub(arect: TRect);
+ public
+ vram, map: TBytes;
+ col_inv: integer;
+ xsize, ysize: integer;
+ top: integer;
+ sheets: TList;
+ screen: TScreen;
+ constructor Create(x, y: integer);
+ destructor Destroy; override;
+ procedure setbuf(index: integer; buffer: TBytes;
+ xsize, ysize, col_inv: integer);
+ procedure updown(sheet: TSheet; height: integer);
+ procedure refresh(bx0, by0, bx1, by1: integer);
+ procedure slide(sheet: TSheet; x, y: integer);
+ procedure delete(index: integer);
+ procedure add(sheet: TSheet);
+ end;
+
+implementation
+
+uses asmhead;
+
+{ TShtCtl }
+
+constructor TShtCtl.Create(x, y: integer);
+begin
+ sheets := TList.Create;
+ SetLength(vram, x * y);
+ SetLength(map, x * y);
+ add(TScreen.Create(x, y, -1));
+end;
+
+procedure TShtCtl.delete(index: integer);
+var
+ s: TSheet;
+begin
+ s := sheets[index];
+ s.Free;
+ sheets.delete(index);
+end;
+
+destructor TShtCtl.Destroy;
+begin
+ screen.Free;
+ sheets.Free;
+ Finalize(vram);
+ Finalize(map);
+ inherited;
+end;
+
+procedure TShtCtl.add(sheet: TSheet);
+begin
+ sheets.add(sheet);
+ sheet.flags := SHEET_USE;
+end;
+
+procedure TShtCtl.refresh(bx0, by0, bx1, by1: integer);
+var
+ i: integer;
+ arect: TRect;
+ s: TSheet;
+begin
+ arect := rect(bx0, by0, bx1, by1);
+ if arect.Left < 0 then
+ arect.Left := 0;
+ if arect.Right >= xsize then
+ arect.Right := xsize;
+ if arect.top < 0 then
+ arect.top := 0;
+ if arect.Bottom >= ysize then
+ arect.Bottom := ysize;
+ for i := 0 to sheets.Count - 1 do
+ begin
+ s := TSheet(sheets[i]);
+ arect.Left := arect.Left - s.vx0;
+ arect.Right := arect.Right - s.vx0;
+ arect.top := arect.top - s.vy0;
+ arect.Bottom := arect.Bottom - s.vy0;
+ if arect.Left < 0 then
+ arect.Left := 0;
+ if arect.Right > xsize then
+ arect.Right := xsize;
+ if arect.top < 0 then
+ arect.top := 0;
+ if arect.Bottom > ysize then
+ arect.Bottom := ysize;
+ refreshmap(arect);
+ refreshsub(arect);
+ end;
+end;
+
+procedure TShtCtl.refreshmap(arect: TRect);
+var
+ i: integer;
+ s: TSheet;
+ x: integer;
+ y: integer;
+ bx0, by0, bx1, by1, vx, vy: integer;
+begin
+ if arect.Left < 0 then
+ arect.Left := 0;
+ if arect.Right > xsize then
+ arect.Right := xsize;
+ if arect.top < 0 then
+ arect.top := 0;
+ if arect.Bottom > ysize then
+ arect.Bottom := ysize;
+ for i := top to sheets.Count - 1 do
+ begin
+ s := TSheet(sheets[i]);
+ if arect.Left < s.vx0 then
+ bx0 := 0
+ else
+ bx0 := arect.Left;
+ if arect.Right > s.vx0 + s.bxsize then
+ bx1 := s.bxsize
+ else
+ bx1 := arect.Right;
+ if arect.top < s.vy0 then
+ by0 := 0
+ else
+ by0 := arect.top;
+ if arect.Bottom > s.bysize then
+ by1 := s.bysize
+ else
+ by1 := arect.Bottom;
+ for y := by0 to by1 do
+ begin
+ vy := s.vy0 + y;
+ for x := bx0 to bx1 do
+ begin
+ vx := s.vx0 + x;
+ if s.vram[y * s.bxsize + x] <> s.col_inv then
+ vram[vy * xsize + vx] := s.col_inv;
+ end;
+ end;
+ end;
+end;
+
+procedure TShtCtl.refreshsub(arect: TRect);
+var
+ x, y, vx, vy: integer;
+ c: integer;
+ s: TSheet;
+begin
+ c := -1;
+ s := nil;
+ for y := arect.top to arect.Bottom do
+ for x := arect.Left to arect.Right do
+ begin
+ if c <> map[y * xsize + y] then
+ begin
+ c := map[y * xsize + x];
+ s := sheets[c];
+ end;
+ vx := x - s.vx0;
+ vy := y - s.vy0;
+ vram[y * xsize + x] := s.vram[vy * s.bxsize + vx];
+ end;
+end;
+
+procedure TShtCtl.setbuf(index: integer; buffer: TBytes;
+ xsize, ysize, col_inv: integer);
+begin
+ sheets.add(TSheet.Create(xsize, ysize, col_inv));
+end;
+
+procedure TShtCtl.slide(sheet: TSheet; x, y: integer);
+var
+ i, j: integer;
+begin
+ i := sheet.vx0;
+ j := sheet.vy0;
+ sheet.vx0 := x;
+ sheet.vy0 := y;
+ if sheet.flags = SHEET_USE then
+ begin
+ refresh(i, j, i + sheet.bxsize, j + sheet.bysize);
+ refresh(x, y, x + sheet.bxsize, y + sheet.bysize);
+ end;
+end;
+
+procedure TShtCtl.updown(sheet: TSheet; height: integer);
+var
+ i, j: integer;
+begin
+ j := -1;
+ for i := 0 to sheets.Count - 1 do
+ if sheet = sheets[i] then
+ j := i;
+ if height >= sheets.Count then
+ height := sheets.Count - 1;
+ if height < -1 then
+ height := -1;
+ if (height >= 0) and (sheet.flags = SHEET_USE) then
+ sheets.Move(j, height);
+end;
+
+{ TPallet }
+
+procedure TSheet.boxfill8(c: UInt8; x0, y0, x1, y1: integer);
+begin
+ clip := rect(x0, y0, x1, y1);
+ boxfill8(c, clip);
+end;
+
+procedure TSheet.boxfill8(c: UInt8; rect: TRect);
+var
+ x: integer;
+ y: integer;
+begin
+ for y := rect.top to rect.Bottom do
+ for x := rect.Left to rect.Right do
+ vram[y * bxsize + x] := c;
+end;
+
+constructor TSheet.Create(x, y, act: integer);
+begin
+ inherited Create;
+ bxsize := x;
+ SetLength(vram, x * y);
+ setp(0, 15, TBytes(@table));
+ hankaku := TResourceStream.Create(HInstance, 'hankaku', RT_RCDATA);
+end;
+
+destructor TSheet.Destroy;
+begin
+ hankaku.Free;
+ Finalize(vram);
+ inherited;
+end;
+
+procedure TSheet.putfont8(x, y: integer; c: Int8; font: PChar);
+var
+ i: integer;
+ p: TBytes;
+ d: Byte;
+begin
+ for i := 0 to 16 do
+ begin
+ p := TBytes(@vram[(y + i) * bxsize + x]);
+ d := Byte(font[i]);
+ if d and $80 <> 0 then
+ p[0] := c;
+ if d and $40 <> 0 then
+ p[1] := c;
+ if d and $20 <> 0 then
+ p[2] := c;
+ if d and $10 <> 0 then
+ p[3] := c;
+ if d and $08 <> 0 then
+ p[4] := c;
+ if d and $04 <> 0 then
+ p[5] := c;
+ if d and $02 <> 0 then
+ p[6] := c;
+ if d and $01 <> 0 then
+ p[7] := c;
+ end;
+end;
+
+procedure TSheet.putfonts8_asc(x, y: integer; c: Int8; s: string);
+var
+ i: integer;
+ buf: array [0 .. 15] of Byte;
+begin
+ s := LowerCase(s);
+ for i := 1 to Length(s) do
+ begin
+ hankaku.Write(TBytes(@buf), Ord(s[i]), 16);
+ putfont8(x, y, c, PChar(@buf));
+ inc(x, 8);
+ end;
+end;
+
+procedure TSheet.putfonts8_asc_sht(x, y: integer; font: string;
+ const back: integer = COL8_000000; const color: integer = COL8_FFFFFF);
+begin
+ clip := rect(x, y, x + bxsize * 8 - 1, y + 15);
+ boxfill8(back, clip);
+ putfonts8_asc(x, y, color, font);
+ refresh := True;
+end;
+
+procedure TSheet.setp(start, endpos: integer; rgb: TBytes);
+var
+ eflags: integer;
+ i, j: integer;
+begin
+ eflags := io_load_eflags;
+ io_cli;
+ io_out8($03C8, start);
+ j := 0;
+ for i := start to endpos - 1 do
+ begin
+ io_out8($03C9, rgb[j + 0] div 4);
+ io_out8($03C9, rgb[j + 1] div 4);
+ io_out8($03C9, rgb[j + 2] div 4);
+ inc(j, 3);
+ end;
+ io_store_eflags(eflags);
+end;
+
+{ TScreen }
+
+constructor TScreen.Create(x, y, act: integer);
+begin
+ inherited;
+ boxfill8(COL8_008484, 0, 0, x - 1, y - 29);
+ boxfill8(COL8_C6C6C6, 0, y - 28, x - 1, y - 28);
+ boxfill8(COL8_FFFFFF, 0, y - 27, x - 1, y - 27);
+ boxfill8(COL8_C6C6C6, 0, y - 26, x - 1, y - 1);
+
+ boxfill8(COL8_FFFFFF, 3, y - 24, 59, y - 24);
+ boxfill8(COL8_FFFFFF, 2, y - 24, 2, y - 4);
+ boxfill8(COL8_848484, 3, y - 4, 59, y - 4);
+ boxfill8(COL8_848484, 59, y - 23, 59, y - 5);
+ boxfill8(COL8_000000, 2, y - 3, 59, y - 3);
+ boxfill8(COL8_000000, 60, y - 24, 60, y - 3);
+
+ boxfill8(COL8_848484, x - 47, y - 24, x - 4, y - 24);
+ boxfill8(COL8_848484, x - 47, y - 23, x - 47, y - 4);
+ boxfill8(COL8_FFFFFF, x - 47, y - 3, x - 4, y - 3);
+ boxfill8(COL8_FFFFFF, x - 3, y - 24, x - 3, y - 3);
+end;
+
+{ TWindow }
+
+constructor TWindow.Create(xsize, ysize: integer; title: string; act: integer);
+begin
+ inherited Create(xsize, ysize, act);
+ putfonts8_asc(24, 4, COL8_FFFFFF, title);
+ boxfill8(COL8_C6C6C6, 0, 0, xsize - 1, 0);
+ boxfill8(COL8_FFFFFF, 1, 1, xsize - 2, 1);
+ boxfill8(COL8_C6C6C6, 0, 0, 0, ysize - 1);
+ boxfill8(COL8_FFFFFF, 1, 1, 1, ysize - 2);
+ boxfill8(COL8_848484, xsize - 2, 1, xsize - 2, ysize - 2);
+ boxfill8(COL8_000000, xsize - 1, 0, xsize - 1, ysize - 1);
+ boxfill8(COL8_C6C6C6, 2, 2, xsize - 3, ysize - 3);
+ boxfill8(COL8_000084, 3, 3, xsize - 4, 20);
+ boxfill8(COL8_848484, 1, ysize - 2, xsize - 2, ysize - 2);
+ boxfill8(COL8_000000, 0, ysize - 1, xsize - 1, ysize - 1);
+ wintitl(title, act);
+end;
+
+procedure TWindow.wintitl(title: string; act: integer);
+const
+ 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
+ for y := 0 to 14 do
+ for x := 1 to 16 do
+ begin
+ c := closebtn[y][x];
+ case c of
+ '@':
+ i := COL8_000000;
+ '$':
+ i := COL8_848484;
+ '0':
+ i := COL8_C6C6C6;
+ else
+ i := COL8_FFFFFF;
+ end;
+ vram[(5 + y) * bxsize + (bxsize - 21 + x)] := i;
+ end;
+end;
+
+{ TCursor }
+
+constructor TCursor.Create(x, y, act: integer);
+const
+ cursor: array [0 .. 15] of string[16] = ( //
+ ('**************..'), //
+ ('*00000000000*...'), //
+ ('*0000000000*....'), //
+ ('*000000000*.....'), //
+ ('*00000000*......'), //
+ ('*0000000*.......'), //
+ ('*0000000*.......'), //
+ ('*00000000*......'), //
+ ('*0000**000*.....'), //
+ ('*000*..*000*....'), //
+ ('*00*....*000*...'), //
+ ('*0*......*000*..'), //
+ ('**........*000*.'), //
+ ('*..........*000*'), //
+ ('............*00*'), //
+ ('.............***') //
+ );
+var
+ i: integer;
+ j: integer;
+begin
+ inherited;
+ for j := 0 to y do
+ for i := 0 to x do
+ case cursor[j, i] of // x , y ?
+ '*':
+ vram[j * 16 + i] := COL8_000000;
+ '0':
+ vram[j * 16 + i] := COL8_FFFFFF;
+ '.':
+ vram[j * 16 + i] := act;
+ end;
+end;
+
+end.
System.SysUtils,
System.Classes,
bootpack in 'bootpack.pas',
- asmhead in 'asmhead.pas';
+ asmhead in 'asmhead.pas',
+ graphic in 'graphic.pas';
const
MEMMAN_ADDR = $003C0000;
var
binfo: ^TBOOTINFO = Pointer(ADR_BOOTINFO);
- screen: TScreen;
- font: TPallet;
- mousefifo: TMouse;
+ mouse: TMouse;
keyboard: TKeyboard;
i: SmallInt;
memtest: TMemtest;
memman: ^TMEMMAN = Pointer(MEMMAN_ADDR);
mem: TMem;
sheet: TShtCtl;
- mouse, win, back: integer;
+ mo, win: TSheet;
s: string;
- buf_win, buf_back, buf_key, buf_mouse: TBytes;
+ fifo: TFifo;
mx, my: integer;
-procedure window8(buf: TBytes; xsize, ysize: integer; title: string);
-const
- 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
- with screen do
- begin
- 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
- c := closebtn[y][x];
- case c of
- '@':
- i := COL8_000000;
- '$':
- i := COL8_848484;
- '0':
- i := COL8_C6C6C6;
- else
- i := COL8_FFFFFF;
- end;
- buf[(5 + y) * xsize + (xsize - 21 + x)] := i;
- end;
-end;
-
begin
{
TAsmhead.Init;
TAsmhead.Boot;
}
- screen:=TScreen.Create(binfo^.vram, binfo^.scrnx, binfo^.scrny);
- keyboard := TKeyboard.Create(32, buf_key);
- mousefifo := TMouse.Create(128, buf_mouse);
- font := TPallet.Create;
- sheet := TShtCtl.Create;
- try
+ fifo := TFifo.Create(128);
+ keyboard := TKeyboard.Create(fifo, 216);
+ mouse := TMouse.Create(fifo, 512);
+ sheet := TShtCtl.Create(binfo^.scrnx,binfo^.scrny);
+ mo := TCursor.Create(16, 16, 99);
+ win := TWindow.Create(160, 68, 'Window', -1);
+ try
+ sheet.add(mo);
+ sheet.add(win);
+ memtest := TMemtest.Create;
+ memtotal := memtest.memtest($00400000, $BFFFFFFF);
{
- memtest:=TMemtest.Create;
- memtotal:=memtest.memtest($00400000,$bfffffff);
mem:=TMem.Create;
mem.Init(memman);
mem.memfree(memman,$00001000,$0009e000);
mem.memfree(memman,$00400000,memtotal-$00400000);
mem.Free;
- memtest.Free;
}
- back := sheet.allock;
- mouse := sheet.allock;
- win := sheet.allock;
- sheet.slide(mouse, 10, 10);
+ memtest.Free;
+ sheet.slide(mo, 10, 10);
sheet.slide(win, 80, 72);
- SetLength(buf_win, 160 * 68);
- 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.screen.putfonts8_asc_sht(0, 28, 'Welcom to');
+ sheet.screen.putfonts8_asc_sht(0, 44, 'Haribote-XE');
+ mx := (sheet.screen.bxsize - 16) div 2;
+ my := (sheet.screen.bysize - 28 - 16) div 2;
+ sheet.slide(mo, mx, my);
sheet.slide(win, 80, 72);
- sheet.updown(back, 0);
- sheet.updown(mouse, 1);
+ sheet.updown(mo, 1);
sheet.updown(win, 2);
// sprintf
- font.putfonts8_asc(binfo^.vram, binfo^.scrnx, 0, 32, COL8_FFFFFF, s);
- sheet.refresh(Rect(0, 0, 80, 16));
+ sheet.screen.putfonts8_asc_sht(0, 32, s);
+ sheet.refresh(0, 0, 80, 16);
while True do
begin
io_cli;
- if keyboard.Status + mousefifo.Status = 0 then
+ if fifo.Status + fifo.Status = 0 then
io_stihlt
else
begin
- if keyboard.Status <> 0 then
+ if fifo.Status <> 0 then
begin
- i := keyboard.Get;
+ i := fifo.Get;
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));
+ sheet.screen.boxfill8(COL8_008484, 0, 16, 15, 31);
+ sheet.screen.putfonts8_asc_sht(0, 16, s);
+ sheet.refresh(0, 16, 16, 32);
end
- else if mousefifo.Status <> 0 then
+ else if fifo.Status <> 0 then
begin
- i := mousefifo.Get;
+ i := fifo.Get;
io_sti;
- if mousefifo.decode(i) <> 0 then
+ if mouse.decode(i) <> 0 then
begin
// sprontf
- if (mousefifo.dec.btn and $01) <> 0 then
+ if (mouse.dec.btn and $01) <> 0 then
s[1] := 'L';
- if (mousefifo.dec.btn and $02) <> 0 then
+ if (mouse.dec.btn and $02) <> 0 then
s[3] := 'R';
- if (mousefifo.dec.btn and $03) <> 0 then
+ if (mouse.dec.btn and $03) <> 0 then
s[2] := 'C';
- screen.boxfill8(buf_back, binfo^.scrnx, COL8_008484, 32, 16,
- 32 + 15 * 8 - 1, 31);
- font.putfonts8_asc(buf_back, binfo^.scrnx, 32, 16, COL8_FFFFFF, s);
- sheet.refresh(Rect(32, 16, 32 + 15 * 8, 32));
- inc(mx, mousefifo.dec.x);
- inc(my, mousefifo.dec.y);
+ sheet.screen.boxfill8(COL8_008484, 32, 16, 32 + 15 * 8 - 1, 31);
+ sheet.screen.putfonts8_asc_sht(32, 16, s);
+ sheet.refresh(32, 16, 32 + 15 * 8, 32);
+ inc(mx, mouse.dec.x);
+ inc(my, mouse.dec.y);
if mx < 0 then
mx := 0;
if my < 0 then
if my > binfo^.scrny - 1 then
my := binfo^.scrny - 1;
// sprintf
- screen.boxfill8(buf_back, binfo^.scrnx, COL8_008484, 0, 0, 78, 15);
- font.putfonts8_asc(buf_back, binfo^.scrnx, 0, 0, COL8_FFFFFF, s);
- sheet.refresh(Rect(0, 0, 80, 16));
- sheet.slide(mouse, mx, my);
+ sheet.screen.boxfill8(COL8_008484, 0, 0, 78, 15);
+ sheet.screen.putfonts8_asc_sht(0, 0, s);
+ sheet.refresh(0, 0, 80, 16);
+ sheet.slide(mo, mx, my);
end;
- sheet.refresh(Rect(0, 0, 80, 16));
+ sheet.refresh(0, 0, 80, 16);
end;
end;
end;
finally
- font.Free;
+ fifo.Free;
sheet.Free;
+ win.Free;
+ mo.Free;
keyboard.Free;
- mousefifo.Free;
- Finalize(buf_win);
- Finalize(buf_key);
- Finalize(buf_mouse);
- screen.Free;
+ mouse.Free;
end;
end.
</DelphiCompile>
<DCCReference Include="bootpack.pas"/>
<DCCReference Include="asmhead.pas"/>
+ <DCCReference Include="graphic.pas"/>
<RcItem Include="hankaku.bin">
<ContainerId>ResourceItem</ContainerId>
<ResourceType>RCDATA</ResourceType>
</DeployFile>
<DeployFile LocalName="Win32\Release\wand.exe" Configuration="Release" Class="ProjectOutput"/>
<DeployFile LocalName="Win32\Debug\wand.exe" Configuration="Debug" Class="ProjectOutput"/>
+ <DeployFile LocalName="Win32\Debug\wand.exe" Configuration="Debug" Class="ProjectOutput">
+ <Platform Name="Win32">
+ <RemoteName>wand.exe</RemoteName>
+ <Overwrite>true</Overwrite>
+ </Platform>
+ </DeployFile>
<DeployFile LocalName="$(BDS)\Redist\osx32\libcgunwind.1.0.dylib" Class="DependencyModule">
<Platform Name="OSX32">
<Overwrite>true</Overwrite>
<Operation>1</Operation>
</Platform>
</DeployClass>
- <ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
+ <ProjectRoot Platform="OSX32" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Android" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSDevice" Name="$(PROJECTNAME).app"/>
<ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Linux64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
<ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/>
- <ProjectRoot Platform="OSX32" Name="$(PROJECTNAME).app"/>
+ <ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
</Deployment>
<Platforms>
<Platform value="Android">False</Platform>
OSDN Git Service
