Jeśli chcesz wziąć udział w dyskusjach na forum - zaloguj się. Jeżeli nie masz loginu - poproś o członkostwo.
Vanilla 1.1.4 jest produktem Lussumo. Więcej informacji: Dokumentacja, Forum.
program pointerTest;
uses crt, graph;
type TChessman = array[0..56] of byte;
const
{* White square, invert Black square *}
WHITE_SQUARE : TChessman = (
$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$FF,$ff
);
{* White pawn on black, invert Black pawn on white *}
PAWN_SE : TChessman = ( $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$18,$00,$00,$3C,$00,$00,$3C,$00,$00,$18,$00,$00,$3C,$00,$00,$7E,$00,$00,$7E,$00,$00,$3C,$00,$00,$18,$00,$00,$18,$00,$00,$3C,$00,$00,$3C,$00,$01,$FF,$80,$01,$FF,$80
);
var chessboard : array[0..2] of word = (
@WHITE_SQUARE, @PAWN_SE, @WHITE_SQUARE
);
i0b, color : byte;
bmpAdr, tmpBmpAdr : word;
procedure renderChessman(var chessman: word; x, y, invert: byte);
var i0b : byte;
tempY : word;
begin
tempY := (y * 760) + 40;
tmpBmpAdr := bmpAdr + 1 + (x * 3);
for i0b := 0 to 18 do begin
poke(tmpBmpAdr + tempY, peek(chessman) xor invert);
Inc(chessman);
poke(tmpBmpAdr + tempY + 1, peek(chessman) xor invert);
Inc(chessman);
poke(tmpBmpAdr + tempY + 2, peek(chessman) xor invert);
Inc(chessman);
Inc(tempY, 40);
end;
end;
begin
InitGraph(8);
bmpAdr := dpeek(88);
SetColor(1);
color := 2;
SetBKColor(color);
TextBackground(color);
for i0b := 0 to 2 do begin
renderChessman(chessboard[i0b], 4, i0b, 0);
writeln(chessboard[i0b]);
end;
ReadKey;
end.
procedure renderChessman(var chessman: word; x, y, invert: byte);
var i0b : byte;
tempY : word;
begin
tempY := (y * 760) + 40;
tmpBmpAdr := bmpAdr + 1 + (x * 3);
for i0b := 0 to 18 do begin
poke(tmpBmpAdr + tempY, peek(chessman) xor invert);
Inc(chessman);
poke(tmpBmpAdr + tempY + 1, peek(chessman) xor invert);
Inc(chessman);
poke(tmpBmpAdr + tempY + 2, peek(chessman) xor invert);
Inc(chessman);
Inc(tempY, 40);
end;
end;
procedure drawBoard;
var i0b, i1b : byte;
invert, piece : byte;
begin
drawRectangle;
piece := 0;
for i1b := 0 to 7 do begin
for i0b := 0 to 7 do begin
if (odd(i0b + i1b)) then invert := 0 else invert := $ff;
if ((i1b > 1) and (i1b < 6)) then invert := not invert;
renderChessman(CHESSBOARD[piece], i0b, i1b, invert);
Inc(piece);
end;
end;
end;
procedure renderChessman(var chessman: word; x, y, invert: byte);
var i0b : byte;
tempY : word;
begin
tempY := (y * 760) + 40;
tmpBmpAdr := bmpAdr + 1 + (x * 3) + tempY;
for i0b := 0 to 18 do begin
poke(tmpBmpAdr, peek(chessman) xor invert);
Inc(chessman);
poke(tmpBmpAdr + 1, peek(chessman) xor invert);
Inc(chessman);
poke(tmpBmpAdr + 2, peek(chessman) xor invert);
Inc(chessman);
Inc(tmpBmpAdr, 40);
end;
end;
procedure renderChessman(var chessman: TChessman; x, y, invert: byte);
procedure renderChessman(chessman: word; x, y, invert: byte);
procedure renderChessman(chessman: word; x, y, invert: byte);
var i0b : byte;
begin
tmpBmpAdr := bmpAdr + 1 + (x * 3) + (y * 760) + 40;
for i0b := 0 to 18 do begin
poke(tmpBmpAdr, peek(chessman) xor invert);
Inc(chessman);
poke(tmpBmpAdr + 1, peek(chessman) xor invert);
Inc(chessman);
poke(tmpBmpAdr + 2, peek(chessman) xor invert);
Inc(chessman);
Inc(tmpBmpAdr, 40);
end;
end;
procedure drawRectangle;
var i0b : byte;
y : word ;
begin
y := 0;
tmpBmpAdr := bmpAdr + 25;
for i0b := 0 to 153 do begin
poke(bmpAdr + y, %00000001);
poke(tmpBmpAdr + y, %10000000);
Inc(y, 40);
end;
tmpBmpAdr := bmpAdr + 6120; // 19*8*40 + 40
for i0b := 1 to 24 do begin
poke(bmpAdr + i0b, $ff);
poke(tmpBmpAdr + i0b, $ff);
end;
end;
procedure drawBoard;
var i0b, i1b : byte;
invert, chessman : byte;
begin
drawRectangle;
chessman := 1;
for i1b := 0 to 7 do begin
for i0b := 0 to 7 do begin
if (Odd(i0b + i1b)) then invert := 0 else invert := $ff;
if ((i1b > 1) and (i1b < 6)) then begin
renderChessman(CHESSBOARD[0], i0b, i1b, not invert);
end else begin
renderChessman(CHESSBOARD[chessman], i0b, i1b, invert);
Inc(chessman);
end;
end;
end;
end;
pieces.inc (81) Warning: Range check error while evaluating constants (8192 must be between 0 and 65535)
tmpBmpAdr := bmpAdr + (x * 3) + (y * 760) + 40 + 1;
//old
tmpBmpAdr := bmpAdr + 1 + (x * 3) + (y * 760) + 40;
//new
tmpBmpAdr := bmpAdr + (x * 3) + (y * 760) + 40 + 1;
procedure renderChessman(chessman: word; x, y, invert: byte);
var i0b : byte;
p : PChar;
begin
p := pointer(bmpAdr + (x * 3) + (y * 760) + 40 + 1);
for i0b := 0 to 18 do begin
p[0]:= chr(peek(chessman) xor invert); inc(chessman);
p[1]:= chr(peek(chessman) xor invert); inc(chessman);
p[2]:= chr(peek(chessman) xor invert); inc(chessman);
Inc(p, 40);
end;
end;
procedure renderChessman(chessman: word; x, y, invert: byte);
var i0b : byte;
p : ^char;
begin
p := pointer(bmpAdr + (x * 3) + (y * 760) + 40 + 1);
for i0b := 0 to 18 do begin
p[0]:= chr(peek(chessman) xor invert); Inc(chessman);
p[1]:= chr(peek(chessman) xor invert); Inc(chessman);
p[2]:= chr(peek(chessman) xor invert); Inc(chessman);
Inc(p, 40);
end;
end;
tebe:
w nowej wersji MP będzie PChar, nie ma ograniczeń STRING-aprocedure renderChessman(chessman: word; x, y, invert: byte);
var i0b : byte;
p : ^byte;
begin
p := pointer(bmpAdr + (x * 3) + (y * 760) + 40 + 1);
for i0b := 0 to 18 do begin
p[0]:= peek(chessman) xor invert; Inc(chessman);
p[1]:= peek(chessman) xor invert; Inc(chessman);
p[2]:= peek(chessman) xor invert; Inc(chessman);
Inc(p, 40);
end;
end;
procedure drawRectangle;
var i0b : byte;
p1, p2 : ^byte;
begin
p1 := pointer(bmpAdr);
p2 := pointer(bmpAdr + 25);
for i0b := 0 to 153 do begin
p1[0]:= %00000001; Inc(p1, 40);
p2[0]:= %10000000; Inc(p2, 40);
end;
p1 := pointer(bmpAdr);
p2 := pointer(bmpAdr + 6120); // 19*8*40 + 40
for i0b := 1 to 24 do begin
p1[i0b] := $ff;
p2[i0b] := $ff;
end;
end;
System UCSD version Time (sec)
------ ------------ ----------
Sage II IV.1 57 (68000 at 8 MHz)
WD uEngine III.0 59 (fillchar is so slow on uE)
LSI-11/23 IV.01 92-122 (depends on memory speed)
LSI-11/23 II.0 105 (98 seconds under IV.01)
LSI-11/23 IV.1 107 (non-extended memory)
LSI-11/23 IV.1 128 (extended memory)
NEC APC IV.1 144 8086 at 4.9 Mhz extended memory
JONOS IV.03 ? 162 (pretty good for a 4 MHz Z-80A)
NorthStar I.5 183 (Z-80 at 4 MHz)
OSI C8P-DF II.0 ? 197 (6502 at 2 MHz)
H-89 II.0 200 (4 MHz Z-80A)
LSI-11/2 IV.0 202
IBM PC IV.03 203 (4.77 MHz 8088)
LSI-11/2 II.0 220
Apple ][ II.1 390 (1 MHz 6502)
H-89 II.0 455 (2 MHz Z-80)
program EightyColumnMode;
uses crt, graph;
type TForBitChar = array[0..4] of byte;
const
CHAR_A : TForBitChar = (
%1110,%1010,%1110,%1010,%1010
);
CHAR_B : TForBitChar = (
%1100,%1010,%1110,%1010,%1110
);
CHAR_C : TForBitChar = (
%1110,%1000,%1000,%1000,%1110
);
CHAR_D : TForBitChar = (
%1100,%1010,%1010,%1010,%1100
);
CHAR_E : TForBitChar = (
%1110,%1000,%1110,%1000,%1110
);
CHAR_F : TForBitChar = (
%1110,%1000,%1110,%1000,%1000
);
CHAR_G : TForBitChar = (
%1110,%1000,%1010,%1010,%1110
);
CHAR_H : TForBitChar = (
%1010,%1010,%1110,%1010,%1010
);
CHAR_SPACE : TForBitChar = (
%0000,%0000,%0000,%0000,%0000
);
FOR_BIT_CHARS : array[0..7] of word = (
CHAR_A,CHAR_B,CHAR_C,CHAR_D,CHAR_E,CHAR_F,CHAR_G,CHAR_H
);
var
ba, tba : word;
col, row, i0b, left : byte;
pressedKey : byte;
charToDraw : word;
begin
// There are 192 rows of 320 dots in the full screen mode.
InitGraph(8);
ba := dpeek(88);
tba := ba - 1;
SetColor(1);
col := 1;
row := 1;
WriteLn('Start typing a,b,c,d,e,f,g ...');
repeat
pressedKey := Ord(ReadKey) - 97;
charToDraw := FOR_BIT_CHARS[pressedKey];
WriteLn(pressedKey, ' --> ', pressedKey);
if ((pressedKey >= 0) and (pressedKey < 8)) then begin
if (Odd(col)) then begin
Inc(tba);
left := 4;
end else left := 0;
for i0b := 0 to 4 do begin
poke(tba, peek(tba) or peek(charToDraw) shl left);
Inc(charToDraw);
Inc(tba, 40);
end;
Dec(tba, 200);
Inc(col);
if (col = 81) then begin
Inc(tba, 200);
Inc(row);
col := 1;
end;
end;
until false;
end.
procedure Print80(x,y:word;s:String);overload;
var
adr,tmp: ^byte;
tl : byte;
chara: ^byte;
charindex : byte;
posindex : byte;
xx : byte;
ch : byte;
d : byte;
ekr: byte;
inv: byte;
begin
// s := Atascii2Antic(s);
inv := 0;
// oblicz adres startowy
posindex := not (x and 1);
adr:=pointer(VIDEO_RAM_ADDRESS+ypos[y]+ (x div 2));
// dlugosc stringa
tl := length(s);
// petla po stringu
charindex := 1;
// posindex := 1;
// posindex wg x, zeby obsluzyc start od drugiej polowki bajtu.
repeat
// adres tmp
tmp := adr;
// adres znaku w zestawie
if (s[charindex]='~') then
begin
inc(charindex,1);
inv := not inv;
end;
chara := pointer(CHARSET_ADDRESS + Atascii2Antic(byte(s[charindex]))*8);
// 8 linii znaku
xx := 0;
repeat
// skopiuj 1 linię znaku (bajt)
move(chara,@ch,1);
d := ch;
// jesli znaki sa juz 4 bitowe, nie roluj
// d := ch and %11000000;
// d := d or (ch shl 1 and %01100000);
// d := d or (ch shl 2 and %00110000);
// d := d or (ch shl 3 and %00010000);
// inwers (ale tylko na polowie znaku)
if (inv <> 0) then
begin
d := d xor %11110000;
d := d and %11110000;
end;
//bajt ekranu do ekr
move(tmp,@ekr,1);
//jesli to druga polowa znaku, przekrec go w prawo
if (posindex and 1) = 0 then d := d shr 4;
//oruj ze znakiem
ekr := ekr or d;
// przepisz na ekran
move(@ekr,tmp,1);
// nowa linia ekranu
inc(tmp,stp);
// nowy bajt znaku
inc(chara,1);
inc(xx,1);
until (xx>7);
// nastepna pozycja znaku
if ((posindex and 1) = 0) then inc(adr,1);
inc(posindex,1);
inc(charindex,1);
until (charindex>tl);
end;
program EightyColumnMode;
uses crt, graph;
type TForBitChar = array[0..4] of byte;
const
CHAR_A : TForBitChar = (
%11101110,%10101010,%11101110,%10101010,%10101010
);
CHAR_B : TForBitChar = (
%11001100,%10101010,%11101110,%10101010,%11101110
);
CHAR_C : TForBitChar = (
%11101110,%10001000,%10001000,%10001000,%11101110
);
CHAR_D : TForBitChar = (
%11001100,%10101010,%10101010,%10101010,%11001100
);
CHAR_E : TForBitChar = (
%11101110,%10001000,%11101110,%10001000,%11101110
);
CHAR_F : TForBitChar = (
%11101110,%10001000,%11101110,%10001000,%10001000
);
CHAR_G : TForBitChar = (
%11101110,%10001000,%10101010,%10101010,%11101110
);
CHAR_H : TForBitChar = (
%10101010,%10101010,%11101110,%10101010,%10101010
);
CHAR_SPACE : TForBitChar = (
0,0,0,0,0
);
FOR_BIT_CHARS : array[0..7] of word = (
CHAR_A,CHAR_B,CHAR_C,CHAR_D,CHAR_E,CHAR_F,CHAR_G,CHAR_H
);
var
ba, tba : word;
col, row, i0b, even : byte;
pressedKey : byte;
charToDraw : word;
begin
// There are 192 rows of 320 dots in the full screen mode.
InitGraph(8);
ba := dpeek(88);
tba := ba - 1;
SetColor(1);
col := 1;
row := 1;
WriteLn('Start typing a,b,c,d,e,f,g ...');
repeat
pressedKey := Ord(ReadKey) - 97;
charToDraw := FOR_BIT_CHARS[pressedKey];
if ((pressedKey >= 0) and (pressedKey < 8)) then begin
if (Odd(col)) then begin
Inc(tba);
even := $f0;
end else even := $0f;
for i0b := 0 to 4 do begin
poke(tba, peek(tba) or (peek(charToDraw) and even));
Inc(tba, 40); Inc(charToDraw);
end;
Dec(tba, 200); Inc(col);
if (col = 81) then begin
Inc(tba, 200); Inc(row);
col := 1;
end;
end;
until false;
end.
- nowy unit EFAST dla przyspieszenia wyprowadzania znaków na urządzenie E:
- SYSTEM: function Copy(var S: String; Index: Byte; Count: Byte): String;
- SYSTEM: Palette, HPalette
- dodana obsługa tablic jednowymiarowych typu ^RECORD (wskaznik do rekordu)
- optymalizacja bloków warunkowych, generowany jest możliwie najkrótszy, najszybszy kod wynikowy
- dodany typ PChar, ->link<-
- dodana możliwość zwracania wartości funkcji przez typ wyliczeniowy
- dodany nowy przełącznik -define:symbol
- dodany nowy przełącznik -ipath:includepath
p[0]:= peek(chessman) xor invert; Inc(chessman);
➜ playground mp 80col.pas
Mad Pascal Compiler version 1.6.2 [2019/11/17] for 6502
Compiling 80col.pas
An unhandled exception occurred at $000000000045A21C:
EAccessViolation: Access violation
$000000000045A21C
$00000000004AA991
fpc -Mdelphi -g mp.pas
gdb mp.exe
run path\80col.pas
(gdb) run 80col.pas
Starting program: /home/zbyti/Temp/mp/mp 80col.pas
Mad Pascal Compiler version 1.6.2 [2019/11/18] for 6502
Compiling 80col.pas
Program received signal SIGSEGV, Segmentation fault.
0x00000000004640a4 in PEEPHOLEOPTIMIZATION (parentfp=0x7ffffffd5be0) at mp.pas:13484
13484 if (pos('ldy ', listing[i-1]) = 0) and (tay(i-1) = false) and // sta :STACKORIGIN+9 ; 0
procedure drawRectangle;
var i0b : byte;
p1, p2 : ^byte;
begin
p1 := pointer(bmpAdr);
p2 := pointer(bmpAdr + 25);
for i0b := 0 to 153 do begin
p1[0]:= %00000001; Inc(p1, 40);
p2[0]:= %10000000; Inc(p2, 40);
end;
p1 := pointer(bmpAdr);
p2 := pointer(bmpAdr + 6120); // 19*8*40 + 40
for i0b := 1 to 24 do begin
p1[i0b] := $ff;
p2[i0b] := $ff;
end;
end;
procedure drawRectangle;
var i0b : byte;
p1, p2 : PChar;
begin
p1 := pointer(bmpAdr);
p2 := pointer(bmpAdr + 25);
for i0b := 0 to 153 do begin
p1[0]:= chr(%00000001); Inc(p1, 40);
p2[0]:= chr(%10000000); Inc(p2, 40);
end;
p1 := pointer(bmpAdr);
p2 := pointer(bmpAdr + 6120); // 19*8*40 + 40
for i0b := 1 to 24 do begin
p1[i0b] := #$ff;
p2[i0b] := #$ff;
end;
end;
procedure drawRectangle;
var i0b : byte;
p1, p2 : ^byte;
begin
p1 := pointer(bmpAdr);
p2 := pointer(bmpAdr + 25);
for i0b := 0 to 153 do begin
p1^:= %00000001; Inc(p1, 40);
p2^:= %10000000; Inc(p2, 40);
end;
p1 := pointer(bmpAdr);
p2 := pointer(bmpAdr + 6120); // 19*8*40 + 40
for i0b := 1 to 24 do begin
inc(p1);
inc(p2);
p1^ := $ff;
p2^ := $ff;
end;
end;
[build-menu]
FT_00_LB=_Skompiluj
FT_00_CM=E:\\atari\\MadPascal\\build.bat %e
FT_00_WD=
EX_00_LB=_Wykonaj
EX_00_CM=E:\\atari\\MadPascal\\buildrun.bat %e
EX_00_WD=
docker run --name test -i -t -v /home/zbyti/Docker/Test:/home ubuntu
