From ade8d7f24490afaf847d834c0ff8120915fd21a0 Mon Sep 17 00:00:00 2001 From: yamat0jp Date: Sun, 4 Nov 2018 20:47:25 +0900 Subject: [PATCH] =?utf8?q?=E5=AE=8C=E6=88=90=E3=81=AB=E3=81=BB=E3=81=A9?= =?utf8?q?=E8=BF=91=E3=81=84=20=E5=AE=9A=E6=95=B0=E3=82=84=E4=BD=9C?= =?utf8?q?=E6=88=90=E3=81=97=E3=81=A6=E3=81=84=E3=81=AA=E3=81=84=E3=83=95?= =?utf8?q?=E3=82=A1=E3=82=A4=E3=83=AB=E3=81=8C=E3=81=82=E3=82=8B?= MIME-Version: 1.0 Content-Type: text/plain; charset=utf8 Content-Transfer-Encoding: 8bit 概ね頭の中で動作は理解している --- bootpack.pas | 1064 +++++++++++++++++++++++++++++++++++++++++++++++++++++++--- contrl.pas | 227 ------------- func.pas | 6 + graphic.pas | 506 ---------------------------- wand.dpr | 88 ++++- wand.dproj | 8 +- 6 files changed, 1095 insertions(+), 804 deletions(-) delete mode 100644 contrl.pas delete mode 100644 graphic.pas diff --git a/bootpack.pas b/bootpack.pas index 68379a3..61d1405 100644 --- a/bootpack.pas +++ b/bootpack.pas @@ -3,8 +3,25 @@ unit bootpack; interface uses - System.Classes, System.Generics.Collections, System.SysUtils, System.Types, - graphic; + System.Classes, System.Generics.Collections, 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 TBOOTINFO = record @@ -13,18 +30,48 @@ type vram: TBytes; end; - TFIFO32 = record - buf: array of UInt32; - p, q, size, free, flags: integer; + TTimer = class + private + timeout: integer; + data: integer; + procedure settime(priority: integer); + public + constructor Create(data0: integer); + end; + + TSS32 = record + backlink, esp0, ss0, esp1, ss1, esp2, ss2, cr3: integer; + eip, esp: Pointer; + eflags, eax, ecx, edx, ebx, ebp, esi, edi: integer; + es, cs, ss, ds, fs, gs: integer; + ldtr, iomap: integer; + end; + + TTask = class + private + sel, flags: integer; + priority, level: integer; + tss: TSS32; + lv_change: Boolean; + public + constructor Create; + procedure run(level, priority: integer); + end; + + TIdle = class(TTask) + public + constructor Create; end; TFifo = class private - fifo: TFIFO32; + buf: array of UInt32; + p, q, size, space, flags: integer; + task: TTask; public constructor Create(size: integer); destructor Destroy; override; - function Put(data: integer): integer; + function Put(data: integer): Boolean; function Get: SmallInt; function Status: integer; end; @@ -39,21 +86,17 @@ type KBC_MODE = $47; private fifo: TFifo; - buf: array [0 .. 255] of Byte; - procedure wait_KBC_sendready; public + procedure wait_KBC_sendready; procedure inthandler21(var esp: integer); virtual; abstract; end; TKeyboard = class(TDevice) - const - cursor_c = COL8_FFFFFF; private keydata: integer; procedure make_table(const keys1, keys2: array of const); public keytable0, keytable1: array [$00 .. $80] of Byte; - cursor_x: integer; constructor Create(fifo: TFifo; data0: integer); procedure inthandler21(var esp: integer); override; end; @@ -61,7 +104,7 @@ type TMOUSE_DEC = record buf: array [0 .. 2] of Byte; phase: Byte; - x, y, btn: integer; + x, y, btn: UInt32; end; TMouse = class(TDevice) @@ -77,6 +120,39 @@ type procedure inthandler21(var esp: integer); override; end; + TTaskCtl = class(TList) + now: integer; + end; + + TCtl = class + private const + MAX_TASKLEVELS = 10; + MAX_TIMER = 500; + procedure taskswitchsub; + + var + list: TList; + buf: array [0 .. MAX_TASKLEVELS - 1] of TTask; + task: array [0 .. MAX_TASKLEVELS] of TTaskCtl; + count: integer; + next: integer; + top: integer; + now_lv: integer; + ts: integer; + mt_timer: TTimer; + procedure inthandler20(var esp: integer); + public + fifo: TFifo; + constructor Create(fifo: TFifo); + destructor Destroy; override; + function run(level, priority: integer): TTask; + procedure remove(task: TTask); + procedure sleep(task: TTask); + function now: TTask; + procedure taskswitch; + function settime(data: integer; timeout: integer): TTimer; + end; + TMemtest = class private function memtest_sub(start, endpos: Cardinal): Cardinal; @@ -85,7 +161,7 @@ type end; TFREEINFO = record - addr, size: Cardinal; + addr, size: UInt32; end; TMEMMAN = class @@ -99,11 +175,88 @@ type TMem = class public procedure Init(mem: TMEMMAN); - function total(mem: TMEMMAN): Cardinal; - function alloc(mem: TMEMMAN; size: Cardinal): Cardinal; + function total(mem: TMEMMAN): UInt32; + function alloc(mem: TMEMMAN; size: UInt32): UInt32; function memfree(mem: TMEMMAN; addr, size: Cardinal): integer; end; + 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 + cursor_c: integer; + cursor_x: integer; + 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) + private + fifo: TFifo; + ctl: TCtl; + public + constructor Create(xsize, ysize: integer; title: string; act: integer); + destructor Destroy; override; + 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 updown(sheet: TSheet; height: integer); + procedure refresh(bx0, by0, bx1, by1: integer); overload; + procedure refresh(obj: TSheet); overload; + procedure slide(sheet: TSheet; x, y: integer); + procedure delete(index: integer); + procedure add(sheet: TSheet); + end; + const FLAGSOVERRUN = $0001; @@ -121,63 +274,141 @@ const PIC1_ICW4 = $00A1; ADR_BOOTINFO = $00000FF0; + ADR_IDT = $0026F800; + LIMIT_IDT = $000007FF; + ADR_GDT = $00270000; + LIMIT_GDT = $0000FFFF; + ADR_BOTPAK = $00280000; + LIMIT_BOTPAK = $0007FFFF; + AR_DATA32_RW = $4092; + AR_CODE32_ER = $409A; + AR_TSS32 = $0089; + AR_INTGATE32 = $008E; implementation -{ TFIFO8 } +uses asmhead, func; + +const + PIT_CTRL = $0043; + PIT_CNT0 = $0040; + + { TTimer } -uses asmhead; +constructor TTimer.Create(data0: integer); +begin + inherited Create; + io_out8(PIT_CTRL, $34); + io_out8(PIT_CNT0, $9C); + io_out8(PIT_CNT0, $2E); + data := data0; + timeout := 0; +end; + +procedure TTimer.settime(priority: integer); +begin + Self.timeout := priority; +end; + +{ TTask } + +constructor TTask.Create; +begin + inherited; + priority := 2; + flags := 1; + with tss do + begin + ldtr := 0; + iomap := $40000000; + eflags := $00000202; + eax := 0; + ecx := 0; + edx := 0; + ebx := 0; + ebp := 0; + esi := 0; + edi := 0; + es := 0; + cs := 0; + ss := 0; + ds := 0; + fs := 0; + gs := 0; + end; +end; + +procedure TTask.run(level, priority: integer); +begin + if level < 0 then + level := Self.level; + if priority > 0 then + Self.priority := priority; + if (flags = 2) and (Self.level <> level) then + flags := 1; + if flags <> 2 then + begin + Self.level := level; + lv_change := true; + end + else + lv_change := false; +end; + +{ TFifo } destructor TFifo.Destroy; begin - Finalize(fifo.buf); + Finalize(buf); inherited; end; function TFifo.Get: SmallInt; begin - if fifo.free = fifo.size then + if space = size then begin result := -1; Exit; end; - result := fifo.buf[fifo.q]; - inc(fifo.q); - if fifo.q = fifo.size then - fifo.q := 0; - inc(fifo.free); + result := buf[q]; + inc(q); + if q = size then + q := 0; + inc(space); end; constructor TFifo.Create(size: integer); begin inherited Create; - SetLength(fifo.buf, size); - fifo.size := size; - fifo.free := size; - fifo.flags := 0; - fifo.p := 0; - fifo.q := 0; + SetLength(buf, size); + size := size; + space := size; + flags := 0; + p := 0; + q := 0; end; -function TFifo.Put(data: integer): integer; +function TFifo.Put(data: integer): Boolean; begin - if fifo.free = 0 then + if space = 0 then begin - fifo.flags := FLAGSOVERRUN; - result := -1; + flags := FLAGSOVERRUN; + result := false; Exit; end; - fifo.buf[fifo.p] := data; - inc(fifo.p); - if fifo.p = fifo.size then - fifo.p := 0; - dec(fifo.free); - result := 0; + buf[p] := data; + inc(p); + if p = size then + p := 0; + dec(space); + if (task <> nil) and (task.flags <> 2) then + task.run(-1, 0); + result := true; end; function TFifo.Status: integer; begin - result := fifo.size - fifo.free; + result := size - space; end; { TMemtest } @@ -248,13 +479,13 @@ end; { TMem } -function TMem.alloc(mem: TMEMMAN; size: Cardinal): Cardinal; +function TMem.alloc(mem: TMEMMAN; size: UInt32): UInt32; var i: integer; s: TFREEINFO; begin result := 0; - for i := 0 to mem.free.Count - 1 do + for i := 0 to mem.free.count - 1 do if mem.free[i].size >= size then begin s := mem.free[i]; @@ -283,7 +514,7 @@ var s: TFREEINFO; begin j := 0; - for i := 0 to mem.free.Count - 1 do + for i := 0 to mem.free.count - 1 do if mem.free[i].addr > addr then begin j := i; @@ -314,17 +545,17 @@ begin begin s.addr := addr; s.size := size; - mem.maxfrees := mem.free.Count; + mem.maxfrees := mem.free.count; mem.free.Insert(i, s); end; end; -function TMem.total(mem: TMEMMAN): Cardinal; +function TMem.total(mem: TMEMMAN): UInt32; var i: integer; begin result := 0; - for i := 0 to mem.free.Count - 1 do + for i := 0 to mem.free.count - 1 do inc(result, mem.free[i].size); end; @@ -413,7 +644,7 @@ end; procedure TDevice.wait_KBC_sendready; begin - while True do + while true do if io_in8(PORT_KEYSTA) and KEYSTA_SEND_NOTREADY = 0 then break; end; @@ -464,4 +695,739 @@ begin keytable1[i] := keys2[i].VType; end; +procedure init_pit(timerctl: TCtl); +begin + +end; + +{ TCtl } + +procedure TCtl.inthandler20(var esp: integer); +var + i: integer; + s: TTimer; +begin + io_out8(PIC0_OCW2, $60); + inc(count); + ts := 0; + if next > count then + Exit; + for i := 0 to list.count - 1 do + begin + s := list[i]; + if s.timeout > count then + begin + s.free; + list.delete(i); + break; + end; + if s <> mt_timer then + fifo.Put(s.data) + else + ts := 1; + end; + next := TTimer(list[0]).timeout; + if ts <> 0 then + taskswitch; +end; + +function TCtl.now: TTask; +begin + result := task[now_lv].Items[top]; +end; + +procedure TCtl.remove(task: TTask); +var + i: integer; + j: integer; + s: TTaskCtl; +begin + for i := 0 to High(Self.task) do + begin + s := Self.task[i]; + for j := 0 to Self.task[i].count - 1 do + if s[j] = task then + s.delete(j); + end; + if s.now >= s.count then + s.now := 0; + task.flags := 1; +end; + +function TCtl.run(level, priority: integer): TTask; +var + i: integer; +begin + result := nil; + for i := 0 to High(buf) do + if buf[i].flags = 1 then + begin + result := buf[i]; + break; + end; + if level >= 0 then + result.level := level; + if priority > 0 then + result.priority := priority; + result.flags := 2; + task[result.level].add(result); +end; + +constructor TCtl.Create(fifo: TFifo); +var + i: integer; + s, s0: TTask; + t: TTimer; +begin + inherited Create; + i := High(buf); + for i := 0 to i - 1 do + buf[i] := TTask.Create; + buf[i] := TIdle.Create; + s0 := buf[i]; + list := TList.Create; + for i := 0 to High(task) do + task[i] := TTaskCtl.Create; + s := buf[0]; + s.flags := 2; + s.priority := 2; + s.level := 0; + Self.fifo := fifo; + fifo.task := s; + task[s.level].add(s); + s.tss.eip := s; + taskswitchsub; + load_tr(s.sel); + mt_timer := settime(0, s.priority); + s0.run(MAX_TASKLEVELS - 1, 1); + task[s.level].add(s0); +end; + +destructor TCtl.Destroy; +var + i, j: integer; + s: TObject; +begin + for i := 0 to High(buf) do + buf[i].free; + for i := 0 to list.count - 1 do + begin + s := list[i]; + s.free; + end; + for i := 0 to High(task) do + task[i].free; + list.free; + inherited; +end; + +function TCtl.settime(data: integer; timeout: integer): TTimer; +var + eflags: integer; + s, timer: TTimer; + i: integer; +begin + if list.count < MAX_TIMER then + begin + eflags := io_load_eflags; + io_cli; + timer := TTimer.Create(data); + timer.settime(timeout + count); + result := timer; + for i := 0 to list.count - 1 do + begin + s := TTimer(list[i]); + if s.timeout >= timer.timeout then + begin + list.Insert(i, timer); + next := s.timeout; + io_store_eflags(eflags); + Exit; + end; + end; + list.add(timer); + io_store_eflags(eflags); + end + else + result := nil; +end; + +procedure TCtl.sleep(task: TTask); +var + s: TTask; +begin + if task.flags = 2 then + begin + s := now; + remove(task); + if s = task then + begin + taskswitchsub; + s := now; + farjump(0, s.sel); + end; + end; +end; + +procedure TCtl.taskswitch; +var + i: integer; + s: TTaskCtl; + t1, t2: TTask; + x: Boolean; + j: integer; +begin + for i := 0 to High(task) do + begin + s := task[i]; + for j := 0 to s.count - 1 do + begin + t1 := s[j]; + if t1.lv_change = true then + begin + t1.lv_change := false; + t1.run(-1, 0); + x := true; + end; + end; + end; + s := task[now_lv]; + t1 := s[s.now]; + s.now := s.now + 1; + if s.now = s.count then + s.now := 0; + if x = true then + begin + taskswitchsub; + s := task[now_lv]; + end; + t2 := s[s.now]; + mt_timer.settime(t2.priority); + if t1 <> t2 then + farjump(0, TTask(task[top]).sel); +end; + +procedure TCtl.taskswitchsub; +var + i: integer; +begin + for i := 0 to High(task) do + if task[i].count > 0 then + now_lv := i; +end; + +{ 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.refresh(obj: TSheet); +var + arect: TRect; +begin + arect:=obj.clip; + refresh(arect.Left+obj.vx0,arect.Top+obj.vy0,arect.Right+obj.vx0,arect.Bottom+obj.vy0); +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.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; + tc, tbc: UInt8; + i: Byte; +begin + if act <> 0 then + begin + tc := COL8_FFFFFF; + tbc := COL8_000084; + end + else + begin + tc := COL8_C6C6C6; + tbc := COL8_848484; + end; + boxfill8(tbc, 3, 3, bxsize - 4, 20); + putfonts8_asc(24, 4, tc, 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; + 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; + +{ TConsole } + +constructor TConsole.Create(xsize, ysize: integer; title: string; act: integer); +var + i, c: integer; + s: TTask; + str: string; +begin + inherited; + s := ctl.now; + fifo := TFifo.Create(128); + fifo.task := s; + cursor_x := 16; + cursor_c := COL8_000000; + ctl.run(ctl.MAX_TASKLEVELS - 1, 1); + s.tss.esp := vram; + ctl := TCtl.Create(fifo); + ctl.settime(0, 50); + while true do + begin + io_cli; + if fifo.Status = 0 then + begin + s := ctl.now; + ctl.sleep(s); + io_sti; + end + else + begin + i := fifo.Get; + io_sti; + if i <= 1 then + begin + if i <> 0 then + begin + ctl.settime(0, 50); + cursor_c := COL8_FFFFFF; + end + else + begin + ctl.settime(1, 50); + cursor_c := COL8_000000; + end; + boxfill8(cursor_c, cursor_x, 28, cursor_x + 7, 43); + clip := rect(cursor_x, 28, cursor_x + 8, 44); + refresh := true; + end; + if (i >= 256) and (i <= 511) then + if i = 8 + 256 then + begin + if cursor_x > 16 then + begin + putfonts8_asc(cursor_x, 28, 1, ' '); + dec(cursor_x, 8); + end; + end + else if cursor_x < 240 then + begin + str[1] := Chr(i - 256); + str[2] := Chr(0); + putfonts8_asc(cursor_x, 28, 1, str); + inc(cursor_x, 8); + end; + boxfill8(cursor_c, cursor_x, 28, cursor_x + 7, 43); + refresh := true; + end; + end; +end; + +destructor TConsole.Destroy; +begin + fifo.free; + ctl.free; + inherited; +end; + +{ TIdle } + +constructor TIdle.Create; +begin + inherited; + with tss do + begin + esp := Pointer(integer(Self) + SizeOf(TIdle)); + eip := Self; + es := 1 * 8; + cs := 2 * 8; + ss := 1 * 8; + ds := 1 * 8; + fs := 1 * 8; + gs := 1 * 8; + end; +end; + end. diff --git a/contrl.pas b/contrl.pas deleted file mode 100644 index 5203ee1..0000000 --- a/contrl.pas +++ /dev/null @@ -1,227 +0,0 @@ -unit contrl; - -interface - -uses System.Classes, bootpack; - -type - TTimer = class - private - timeout: integer; - data: integer; - procedure settime(timeout: integer); - public - constructor Create(data0: integer); - end; - - TSS32 = record - backlink, esp0, ss0, esp1, ss1, esp2, ss2, cr3: integer; - eip, eflags, eax, ecx, edx, ebx, esp, ebp, esi, edi: integer; - es, cs, ss, ds, fs, gs: integer; - ldtr, iomap: integer; - end; - - TTask = class - public - sel, flags: integer; - tss: TSS32; - constructor Create; - end; - - TCtl = class - private - list: TList; - task: TList; - count: integer; - next: integer; - top: integer; - mt_timer: TTimer; - ts: integer; - procedure inthandler20(var esp: integer); - public - fifo: TFifo; - constructor Create(fifo: TFifo); - destructor Destroy; override; - procedure run; - procedure taskswitch; - function settime(data: integer; timeout: integer): Boolean; - end; - -procedure init_pit(timerctl: TCtl); - -implementation - -uses asmhead, func; - -const - PIT_CTRL = $0043; - PIT_CNT0 = $0040; - MAX_TIMER = 500; - -procedure init_pit(timerctl: TCtl); -begin - -end; - -{ TTimer } - -constructor TTimer.Create(data0: integer); -begin - inherited Create; - io_out8(PIT_CTRL, $34); - io_out8(PIT_CNT0, $9C); - io_out8(PIT_CNT0, $2E); - data := data0; - timeout := 0; -end; - -procedure TTimer.settime(timeout: integer); -begin - Self.timeout := timeout; -end; - -{ TCtl } - -procedure TCtl.inthandler20(var esp: integer); -var - i: integer; - s: TTimer; -begin - io_out8(PIC0_OCW2, $60); - inc(count); - ts := 0; - if next > count then - Exit; - for i := 0 to list.count - 1 do - begin - s := list[i]; - if s.timeout > count then - begin - s.Free; - list.Delete(i); - break; - end; - if s <> mt_timer then - fifo.Put(s.data) - else - ts := 1; - end; - next := TTimer(list[0]).timeout; - if ts <> 0 then - taskswitch; -end; - -procedure TCtl.run; -begin - -end; - -constructor TCtl.Create(fifo: TFifo); -begin - inherited Create; - list := TList.Create; - task := TList.Create; - Self.fifo := fifo; - settime(2, 2); - mt_timer := list[0]; -end; - -destructor TCtl.Destroy; -var - i: integer; - s: TObject; -begin - for i := 0 to list.count - 1 do - begin - s := list[i]; - s.Free; - end; - for i := 0 to task.count - 1 do - begin - s := task[i]; - s.Free; - end; - list.Free; - task.Free; - inherited; -end; - -function TCtl.settime(data: integer; timeout: integer): Boolean; -var - eflags: integer; - s, timer: TTimer; - i: integer; -begin - if list.count < MAX_TIMER then - begin - result:=true; - eflags := io_load_eflags; - io_cli; - timer := TTimer.Create(data); - timer.settime(timeout + count); - for i := 0 to list.count - 1 do - begin - s := TTimer(list[i]); - if s.timeout >= timer.timeout then - begin - list.Insert(i, timer); - next := s.timeout; - io_store_eflags(eflags); - Exit; - end; - end; - list.Add(timer); - io_store_eflags(eflags); - end - else - result := false; -end; - -procedure TCtl.taskswitch; -begin - mt_timer.settime(2); - if top >= 2 then - begin - inc(top); - if top >= task.count then - top := 0; - farjump(0, TTask(task[top]).sel); - end; -end; - -{ TTask } - -constructor TTask.Create; -var - task_esp: integer; -begin - with tss do - begin - ldtr := 0; - iomap := $40000000; - ldtr := 0; - iomap := $40000000; - set_segmdesc(gdt + 3, 103, Self, AR_TSS32); - load_tr(3 * 8); - task_esp := integer(Self); - Pointer(eip) := @main; - eflags := $00000202; // * IF = 1; */ - eax := 0; - ecx := 0; - edx := 0; - ebx := 0; - esp := task_esp; - ebp := 0; - esi := 0; - edi := 0; - es := 1 * 8; - cs := 2 * 8; - ss := 1 * 8; - ds := 1 * 8; - fs := 1 * 8; - gs := 1 * 8; - end; - task_esp := sht_back - 4; -end; - -end. diff --git a/func.pas b/func.pas index 7c90614..07eb8d3 100644 --- a/func.pas +++ b/func.pas @@ -3,6 +3,7 @@ unit func; interface procedure farjump(eip, cs: integer); +procedure load_tr(tr: integer); implementation @@ -11,4 +12,9 @@ begin end; +procedure load_tr(tr: integer); +begin + +end; + end. diff --git a/graphic.pas b/graphic.pas deleted file mode 100644 index 3ed34c5..0000000 --- a/graphic.pas +++ /dev/null @@ -1,506 +0,0 @@ -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. diff --git a/wand.dpr b/wand.dpr index 7da7b8e..571504e 100644 --- a/wand.dpr +++ b/wand.dpr @@ -7,8 +7,6 @@ uses System.Classes, bootpack in 'bootpack.pas', asmhead in 'asmhead.pas', - graphic in 'graphic.pas', - contrl in 'contrl.pas', func in 'func.pas'; const @@ -19,13 +17,14 @@ var mouse: TMouse; ctl: TCtl; keyboard: TKeyboard; + key_to: integer; i: SmallInt; memtest: TMemtest; memtotal: Cardinal; memman: ^TMEMMAN = Pointer(MEMMAN_ADDR); mem: TMem; sheet: TShtCtl; - mo, win: TSheet; + mo, win, cons: TSheet; s: string; fifo: TFifo; mx, my: integer; @@ -37,14 +36,17 @@ begin } fifo := TFifo.Create(128); keyboard := TKeyboard.Create(fifo, 216); + key_to := 0; mouse := TMouse.Create(fifo, 512); ctl := TCtl.Create(fifo); sheet := TShtCtl.Create(binfo^.scrnx, binfo^.scrny); mo := TCursor.Create(16, 16, 99); - win := TWindow.Create(160, 68, 'Window', -1); + win := TWindow.Create(160, 68, 'Window', 0); + cons := TConsole.Create(160, 100, 'Console', 1); try sheet.add(mo); sheet.add(win); + sheet.add(cons); memtest := TMemtest.Create; memtotal := memtest.memtest($00400000, $BFFFFFFF); { @@ -78,22 +80,74 @@ begin i := fifo.Get; io_sti; if (i >= 256) and (i <= 511) then - with keyboard do + begin + if i >= $54 + 256 then + if (keyboard.keytable0[i - 256] <> 0) and (win.cursor_x < 144) then + begin + s[1] := Char(keyboard.keytable0[i - 256]); + win.putfonts8_asc_sht(win.cursor_x, 28, s); + inc(win.cursor_x, 8); + end; + if (i <= 256 + $0E) and (win.cursor_x > 8) then begin - if i >= $54 + 256 then - if (keytable0[i - 256] <> 0) and (cursor_x < 144) then - begin - s[1] := Char(keytable0[i - 256]); - win.putfonts8_asc_sht(cursor_x, 28, s); - inc(cursor_x, 8); - end; - if (i <= 256 + $0E) and (cursor_x > 8) then + win.putfonts8_asc_sht(win.cursor_x, 28, ' '); + dec(win.cursor_x, 8); + end; + if i = 256 + $0F then + begin + if key_to = 0 then begin - win.putfonts8_asc_sht(cursor_x, 28, ' '); - dec(cursor_x, 8); + key_to := 1; + sheet.updown(win, 0); + sheet.updown(cons, 1); + end + else + begin + key_to := 0; + sheet.updown(win, 1); + sheet.updown(cons, 0); end; - win.boxfill8(cursor_c, cursor_x, 28, cursor_x + 8, 44); - end + end; + win.clip:=Rect(0,0,win.bxsize,21); + cons.clip:=Rect(0,0,cons.bxsize,21); + sheet.refresh(win); + sheet.refresh(cons); + case i of + 256 + $2A: + key_shift := key_shift or 1; + 256 + $36: + key_shift := key_shift and 1; + 256 + $AA: + ; + 256 + $B6: + ; + 256 + $3A: + begin + key_leds = key_leds * key_leds * key_leds * key_leds; + fifo.Put(KEYCMD_LED); + fifo.Put(key_leds); + end; + 256 + $45: + begin + key_leds := key_leds * key_leds; + fifo.Put(KEYCMD_LED); + fifo.Put(key_leds); + end; + 256 + $46: + begin + fifo.Put(KEYCMD_LED); + fifo.Put(key_leds); + end; + 256 + $FA: + keycmd_wait := -1; + 256 + $FE: + begin + keyboard.wait_KBC_sendready; + io_out8(TKeyboard.PORT_KEYDAT, keycmd_wait); + end; + end; + win.boxfill8(win.cursor_c, win.cursor_x, 28, win.cursor_x + 8, 44); + end else if (i >= 512) and (i <= 711) then begin if mouse.decode(i) <> 0 then diff --git a/wand.dproj b/wand.dproj index 315e8de..b41bb96 100644 --- a/wand.dproj +++ b/wand.dproj @@ -140,8 +140,6 @@ - - ResourceItem @@ -564,15 +562,15 @@ 1 - + - - + + False -- 2.11.0