wand.dpr

   1 program wand;
   2
   3 uses
   4   System.SysUtils,
   5   System.Classes,
   6   bootpack in 'bootpack.pas',
   7   asmhead in 'asmhead.pas';
   8
   9 const
  10   MEMMAN_ADDR = $003C0000;
  11
  12 var
  13   binfo: ^TBOOTINFO = Pointer(ADR_BOOTINFO);
  14   screen: TScreen;
  15   font: TPallet;
  16   mousefifo: TMouse;
  17   keyboard: TKeyboard;
  18   i: SmallInt;
  19   memtest: TMemtest;
  20   memtotal: Cardinal;
  21   memman: ^TMEMMAN = Pointer(MEMMAN_ADDR);
  22   mem: TMem;
  23   sheet: TShtCtl;
  24   mouse, win, back: integer;
  25   s: string[40];
  26   buf_win, buf_back, keybuf, buf_mouse: TBytes;
  27   mx, my: integer;
  28
  29 procedure window8(buf: TBytes; xsize, ysize: integer; title: PAnsiChar);
  30 const
  31   closebtn: array [0 .. 14] of string[16] = ( //
  32     ('000000000000000@'), //
  33     ('0QQQQQQQQQQQQQ$@'), //
  34     ('0QQQQQQQQQQQQQ$@'), //
  35     ('0QQQQQQQQQQQQQ$@'), //
  36     ('0QQQ@@QQQQ@@QQ$@'), //
  37     ('0QQQQ@@QQ@@QQQ$@'), //
  38     ('0QQQQQ@@@@QQQQ$@'), //
  39     ('0QQQQQQ@@QQQQQ$@'), //
  40     ('0QQQQQ@@@@QQQQ$@'), //
  41     ('00QQQ@@QQ@@QQQ$@'), //
  42     ('0QQQ@@QQQQ@@QQ$@'), //
  43     ('0QQQQQQQQQQQQQ$@'), //
  44     ('0QQQQQQQQQQQQQ$@'), //
  45     ('0$$$$$$$$$$$$$$@'), //
  46     ('@@@@@@@@@@@@@@@@') //
  47     );
  48 var
  49   y: integer;
  50   x: integer;
  51   c: AnsiChar;
  52   i: Byte;
  53 begin
  54   with screen do
  55   begin
  56     boxfill8(buf, xsize, COL8_C6C6C6, 0, 0, xsize - 1, 0);
  57     boxfill8(buf, xsize, COL8_FFFFFF, 1, 1, xsize - 2, 1);
  58     boxfill8(buf, xsize, COL8_C6C6C6, 0, 0, 0, ysize - 1);
  59     boxfill8(buf, xsize, COL8_FFFFFF, 1, 1, 1, ysize - 2);
  60     boxfill8(buf, xsize, COL8_848484, xsize - 2, 1, xsize - 2, ysize - 2);
  61     boxfill8(buf, xsize, COL8_000000, xsize - 1, 0, xsize - 1, ysize - 1);
  62     boxfill8(buf, xsize, COL8_C6C6C6, 2, 2, xsize - 3, ysize - 3);
  63     boxfill8(buf, xsize, COL8_000084, 3, 3, xsize - 4, 20);
  64     boxfill8(buf, xsize, COL8_848484, 1, ysize - 2, xsize - 2, ysize - 2);
  65     boxfill8(buf, xsize, COL8_000000, 0, ysize - 1, xsize - 1, ysize - 1);
  66   end;
  67   font.putfonts8_asc(buf, xsize, 24, 4, COL8_FFFFFF, title);
  68   for y := 0 to 14 do
  69     for x := 1 to 16 do
  70     begin
  71       c := closebtn[y][x];
  72       case c of
  73         '@':
  74           i := COL8_000000;
  75         '$':
  76           i := COL8_848484;
  77         '0':
  78           i := COL8_C6C6C6;
  79       else
  80         i := COL8_FFFFFF;
  81       end;
  82       buf[(5 + y) * xsize + (xsize - 21 + x)] := i;
  83     end;
  84 end;
  85
  86 begin
  87   screen := TScreen.Create;
  88   screen.Init(binfo^.vram, binfo^.scrnx, binfo^.scrny);
  89   keyboard := TKeyboard.Create;
  90   mousefifo := TMouse.Create;
  91   {
  92     memtest:=TMemtest.Create;
  93     memtotal:=memtest.memtest($00400000,$bfffffff);
  94     mem:=TMem.Create;
  95     mem.Init(memman);
  96     mem.memfree(memman,$00001000,$0009e000);
  97     mem.memfree(memman,$00400000,memtotal-$00400000);
  98     mem.Free;
  99     memtest.Free;
 100   }
 101   font := TPallet.Create;
 102   sheet := TShtCtl.Create;
 103   back := sheet.allock;
 104   mouse := sheet.allock;
 105   win := sheet.allock;
 106   sheet.slide(mouse, 10, 10);
 107   sheet.slide(win, 80, 72);
 108   SetLength(buf_win, 160 * 68);
 109   SetLength(keybuf, 32);
 110   SetLength(buf_mouse, 128);
 111   sheet.setbuf(back, buf_back, binfo^.scrnx, binfo^.scrny, -1);
 112   sheet.setbuf(mouse, buf_mouse, 16, 16, 99);
 113   sheet.setbuf(win, buf_win, 160, 68, -1);
 114   font.mouse_cursor8(buf_mouse, 99);
 115   window8(buf_win, 160, 68, 'window');
 116   font.putfonts8_asc(buf_win, 160, 24, 28, COL8_000000, 'Welcom to');
 117   font.putfonts8_asc(buf_win, 160, 24, 44, COL8_000000, 'Haribote-XE');
 118   mx := (binfo^.scrnx - 16) div 2;
 119   my := (binfo^.scrny - 28 - 16) div 2;
 120   sheet.slide(mouse, mx, my);
 121   sheet.slide(win, 80, 72);
 122   sheet.updown(back, 0);
 123   sheet.updown(mouse, 1);
 124   sheet.updown(win, 2);
 125   // sprintf
 126   font.putfonts8_asc(binfo^.vram, 0, 32, COL8_FFFFFF, s);
 127   sheet.refresh(Rect(0, 0, 80, 16));
 128   mousefifo.Init(mousefifo.fifo8, 128, buf_mouse);
 129   keyboard.Init(keyboard.fifo8, 32, keybuf);
 130   while True do
 131   begin
 132     io_cli;
 133     if keyboard.fifo.Status(keyboard.fifo8) + mousefifo.fifo.Status
 134       (mousefifo.fifo8) = 0 then
 135       io_stihlt
 136     else
 137     begin
 138       if keyboard.fifo.Status(keyboard.fifo8) <> 0 then
 139       begin
 140         i := keyboard.fifo.Get(keyboard.fifo8);
 141         io_sti;
 142         // sprintf
 143         screen.boxfill8(buf_back, binfo^.scrnx, COL8_008484, 0, 16, 15, 31);
 144         font.putfonts8_asc(buf_back, binfo^.scrnx, 0, 16, COL8_FFFFFF, s);
 145         sheet.refresh(Rect(0, 16, 16, 32));
 146       end
 147       else if mousefifo.fifo.Status(mousefifo.fifo8) <> 0 then
 148       begin
 149         i := mousefifo.fifo.Get(mousefifo.fifo8);
 150         io_sti;
 151         sheet.refresh(Rect(0, 0, 80, 16));
 152       end;
 153     end;
 154   end;
 155   font.Free;
 156   sheet.Free;
 157   keyboard.Free;
 158   mousefifo.Free;
 159   Finalize(keybuf);
 160   screen.Free;
 161
 162 end.