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.
dictionary:
'00000', '*' // 0
'00001', 'b' // 1
'00010', 'c' // 2
'00011', 'd' // 3
'00100', 'e' // 4
'00101', 'f' // 5
'00110', 'g' // 6
'00111', 'h' // 7
'01000', 'i' // 8
'01001', 'j' // 9
'01010', 'k' // 10
'01011', 'l' // 11
'01100', 'm' // 12
'01101', 'n' // 13
'01110', 'o' // 14
'01111', 'p' // 15
'10000', 'q' // 16
'10001', 'r' // 17
'10010', 's' // 18
'10011', 't' // 19
'10100', 'u' // 20
'10101', 'v' // 21
'10110', 'w' // 22
'10111', 'x' // 23
'11000', 'y' // 24
'11001', 'z' // 25
'11010', 'A' // 26
'11011', 'B' // 27
'11100', 'C' // 28
'11101', 'D' // 29
'11110', 'E' // 30
'11111', '!' // 31
source size 1225:
1011111000011110011011110100001101101100101000111110000010000110111001001001010000111100101101111001010000011101100010111101110001110000100101110000100100000011010010101110110010001011110110011101010101000000001101110111001111110010010011111110111100000001001010001010101001010111011010100011000010100111100110101001000101101011110101000011110001001011110001001011100111100001011111111011100010100110101111100111010010010000111101000101010111000100000001001101011110001011111000010011000100100100101010011110010101111111101001011110000000111101011100000100010001010011010011010100100110111011110110100100011110000111001110000010011010011010011100001100110101010101010001011011101111100010101110100011001000000111001011100100010100101111110010111111010010101000110001001010110010000111101110110111101101000011100100011100001111011010000010001010110000001110011001010101110100111111001100011111000000011010010011011110101100000100000100001100010001000100100001111110011000100110110111101011011110011101011001000111010011111101111100110001001100011011010111111000111110110110010110001101000000111101000000101111110100000010010010010001101011011110011000011001001011111010101010001000011111000101001001111011000011001000100100001
output size 245:
xypgEqBmupqinzeuhsBzihmlBryjocidjlwixwovi*BxhCspDC*srksxniykpgurnpkdysEexhqx!ofgxzAjbDcvyqcnpc!bgesktzl!uxqdACcekngutoEAiEdtqjuAodgvkrnBCkDdebzoiuxCxDfiyswipoBBioiChwqivqhgkxj!ghybutpl*qimirehCytnDnCDmrApBCytdnpy!nsyA*Eqf!icjennCyms!kuiprjhwdejb [END]
'b'..'z': begin
v:=ord(qr[i0]) - ord('a');
binLine := binStr(v, 5);
end;
for i0 := 1 to 245 do begin
case qr[i0] of
'!' : binLine := %11111;
'*' : binLine := %00000;
'b'..'z': binLine := ord(qr[i0]) - ord('a');
'A'..'E': binLine := ord(qr[i0]) - 39;
end;
for i1 := 0 to 4 do begin
if (binLine and %10000 <> 0) then PutPixel(x,y);
binLine:=binLine shl 1;
x := x + 1;
if (x = 35) then begin
x := 0;
y := y +1;
end;
end;
end;
program depacker;
uses crt, fastgraph;
var qrCode: string = 'PPPPPPPAcfhOibHKgApLNEkCeMKfEkkgKKfElOoKkfHKJeeLNAcFkFibPPmIOpPDdKnknbDffCpGnEkJJJODFNCEOHJNaEbfphEopIGanGcGaMMDDeFJNijGIJedGPGNmoFpnHADFJODCfNFBMpMkkNccPCFfCLGNNCpdBOLOOCJKPpBldNdaDPOmjPoLAdoFBkhHKOEAojEkemDaNElkCppJElFbJplHKifJApAcBldLNPPPPPPP';
i0, i1, x, y, dicLA, dicCA, qrBlock : byte;
begin
InitGraph(5);
SetColor(1);
// the 5-bit dictionary has 16 capital letters 'A'..'P'
// and 16 lowercasers 'a'..'p'
dicLA := ord('a');
dicCA := ord('A') - 16; // second half of dictionary
// point coordinates
x := 0;
y := 0;
for i0 := 1 to 245 do begin
case qrCode[i0] of
'a'..'p': qrBlock := ord(qrCode[i0]) - dicLA;
'A'..'P': qrBlock := ord(qrCode[i0]) - dicCA;
end;
for i1 := 1 to 5 do begin
if (qrBlock and %10000 <> 0) then PutPixel(x,y);
qrBlock := qrBlock shl 1;
x := x + 1;
if (x = 35) then begin
x := 0;
y := y + 1;
end;
end;
end;
ReadKey;
end.
program shl_example;
uses crt;
var v, i : byte;
begin
v := %01001;
writeln('Hello ATARI!');
for i := 1 to 5 do begin
writeln('');
write(binStr(v, 5));
if (v and %10000 <> 0) then
write(' --> Bingo ', binStr((v and %10000), 5))
;
v := v shl 1;
end;
ReadKey;
end.
{$H+}
program Compressor;
var qrCode : string = '1111111111111111111111111111111111110000000100010100111111100100000001101111101000110100000111111011111011010001010100100010011100110100010110100010100101000110110101101000101101000101111110011101101001010001011011111010110010010000100110111110110000000101010101010101010100000001111111111101100110001111001111111111001100011110100110101010011010000110011001010010110010011111011001101101000101011001110011100111110100111010111101100101010011110101111100111101000001010000001001010111100111101000111001111110001011000000011011011000010101100000011100111001001110011001001010111001111010100001001101101100011001001000001110110111111011011101011000111010101011110110110111100001001110101110011111010011100100010111101101011000111100011111110001010010101110100010000101111110010101010010110010110111011011101111011001001111000111000111110110111111011110100101100111010111110111110001010110001111101000110000010011111111111001100010011111101110110111000000011011101010110001010100011110111110101111010100100000111001001101000101000100011001001100000111011010001011010101001001111011111100110100010111010100001110010111101011101111101001000001011100110000011111000000010100010101100011110111110111111111111111111111111111111111111';
qrBlock : string = '%';
i : smallint = 1;
dicLA, dicCA : byte;
letterCode, error : byte;
begin
// the 5-bit dictionary has 16 capital letters 'A'..'P' and 16 lowercasers 'a'..'p'
dicLA := ord('a');
dicCA := ord('A') - 16; // second half of dictionary
repeat
qrBlock := qrBlock + copy(qrCode, i, 5);
val(qrBlock, letterCode, error);
if (letterCode > 15) then
write(chr(letterCode + dicCA))
else
write(chr(letterCode + dicLA))
;
qrBlock := '%';
i := i + 5;
until i = 1226;
writeln(' [END]');
end.
uses sysutils;
var start, stop : cardinal;
begin
start := GetTickCount;
<< LOOP >>
stop := GetTickCount;
writeln(stop - start);
end.
//Dyrektywa
{$f $a0} // fastmul at page $a0 ($a000)
{$H+}
program Compressor;
var qrCode : string = '1111111111111111111111111111111111110000000100010100111111100100000001101111101000110100000111111011111011010001010100100010011100110100010110100010100101000110110101101000101101000101111110011101101001010001011011111010110010010000100110111110110000000101010101010101010100000001111111111101100110001111001111111111001100011110100110101010011010000110011001010010110010011111011001101101000101011001110011100111110100111010111101100101010011110101111100111101000001010000001001010111100111101000111001111110001011000000011011011000010101100000011100111001001110011001001010111001111010100001001101101100011001001000001110110111111011011101011000111010101011110110110111100001001110101110011111010011100100010111101101011000111100011111110001010010101110100010000101111110010101010010110010110111011011101111011001001111000111000111110110111111011110100101100111010111110111110001010110001111101000110000010011111111111001100010011111101110110111000000011011101010110001010100011110111110101111010100100000111001001101000101000100011001001100000111011010001011010101001001111011111100110100010111010100001110010111101011101111101001000001011100110000011111000000010100010101100011110111110111111111111111111111111111111111111';
qrBlock : string = '%';
dicFirstLetter : byte;
letterCode, error : byte;
i : smallint = 1;
begin
dicFirstLetter := ord('A');
repeat
qrBlock := qrBlock + copy(qrCode, i, 5);
val(qrBlock, letterCode, error);
write(chr(letterCode + dicFirstLetter));
qrBlock := '%';
i := i + 5;
until i = 1226;
writeln(' [END]');
end.
program depacker;
uses crt, fastgraph;
var qrCode : string = '```````QCFH_IBX[GQP\^UKSE[FUKKG[[FUL_O[KFX[ZEE\^QCVKVIB``MY_P`TD[NKNBTFFSPWNUKZZZ_TV^SU_XZ^AUBFPHUOPYWANWCWA]]TTEVZ^IJWYZEDW`W^MOVPNXQTVZ_TSF^VR]P]KK^CC`SVFS\W^^SPDR_\__SZ[`PRLD^DAT`_MJ`O\QDOVRKHX[_UQOJUKEMTA^ULKSPPZULVBZPLX[IFZQPQCRLD\^```````';
i0, i1, x, y : byte;
dicFirstLetter, qrBlock : byte;
begin
InitGraph(5);
SetColor(1);
x := 0;
y := 0;
dicFirstLetter := ord('A');
for i0 := 1 to 245 do begin
qrBlock := ord(qrCode[i0]) - dicFirstLetter;
for i1 := 1 to 5 do begin
if (qrBlock and %10000 <> 0) then PutPixel(x,y);
qrBlock := qrBlock shl 1;
x := x + 1;
if (x = 35) then begin
x := 0;
y := y + 1;
end;
end;
end;
ReadKey;
end.
dicFirstLetter := 0;
qrBlock := qrBlock + copy(qrCode, i, 8);
if (qrBlock and %10000000 <> 0) then PutPixel(x,y);
// tutaj iteracja do 1225 ze skokiem 7
dicFirstChar := 0; // można zacząć od innego znaku
write(chr(letterCode + dicFirstChar));
program znaki;
var i : byte;
begin
for i := 0 to 255 do write(chr(i));
end.
program znaki;
var i : byte;
begin
for i := 33 to 126 do write(chr(i));
end.
bmp_adr:=dpeek(88); // adres pamięci obrazu
fillchar(pointer(bmp_adr), 192*40, 0);
procedure cls;
begin
fillchar(pointer(bmpAdr), 40*40, 0);
ClrScr;
end;
qrBlock := qrCode[i0] and $3F
dicFirstChar : byte = 40;
write(chr(i)); // spowoduje dla i
i = 125 // kasuje ekran
i = 156 // kasuje linie
i = 160 // kursor (inwersja spacji)
i = 253 // dźwięk systemowy
for i2 := 2 to 3 do begin
threeCodes := %000000000000;
threeCodes := threeCodes or (ord(qrCode[i2]) - dicFirstChar);
threeCodes := threeCodes shl 6;
threeCodes := threeCodes or (ord(qrCode[i2 + 1]) - dicFirstChar);
for i0 := 1 to 3 do begin
for i1 := 1 to 4 do begin
if (threeCodes and %100000000000 = 0) then begin
qrBlock := qrBlock shl 2;
qrBlock := qrBlock or %10;
end else begin
qrBlock := qrBlock shl 2;
end;
threeCodes := threeCodes shl 1;
end;
dpoke(bmpAdr + x, qrBlock);
qrBlock := 0;
x := x + 1;
end;
end;
InitGraph(7);
bmpAdr := dpeek(88);
procedure cls(x, y, rX, rY, color: byte);
var i0 : byte;
i2 : word;
bmpAdrXY : word;
begin
i2 := 0;
bmpAdrXY := bmpAdr + x + (40 * y);
for i0 := 1 to rY do begin
fillchar(pointer(bmpAdrXY + i2), rX, color);
i2 := i2 + 40;
end;
end;
tOra: array [0..7] of byte = ($80,$40,$20,$10,$08,$04,$02,$01);
...
...
InitGraph(6);
for x:=0 to 52 do begin
k:=dpeek(88) + x shr 3;
v:=peek(k);
poke(k, v or tOra[x and 7]);
end;
program chessboard;
uses crt, fastgraph;
var bmpAdr : word;
procedure drawBoard;
var i1b, i2b, i3b, color, modLine : byte;
x, y : smallint;
begin
modLine := 0;
y := 280; // x * 40
for i3b := 1 to 8 do begin
for i2b := 1 to 22 do begin
x := 1;
for i1b := 1 to 8 do begin
color := $ff;
if (i1b and %1 <> modLine) then color := 0;
dpoke(bmpAdr + y + x, color);
dpoke(bmpAdr + y + x + 1, color);
dpoke(bmpAdr + y + x + 2, color);
x := x + 3;
end;
y := y + 40;
end;
if (i3b and %1 = 0) then modLine := 0
else modLine := 1;
end;
rectangle(7, 7, 40 * 5, (22 * 8) + 7);
end;
begin
InitGraph(8 + 16);
SetColor(1);
TextBackground($ff);
bmpAdr := dpeek(88);
drawBoard;
readkey;
end.
{$f $a0} // fastmul at page $a0 ($a000)
program slow_chessboard;
uses crt, fastgraph;
var i1b, i2b, x, y : byte;
i1i, a : integer;
bmpAdr : word;
begin
InitGraph(8);
SetColor(1);
TextBackground(0);
bmpAdr := dpeek(88);
x := 20;
y := 0;
a := 19;
rectangle(x, y, x + ((1 + a) * 8), y + (a * 8));
for i1b := 1 to 4 do begin
for i2b := 0 to 3 do begin
for i1i := (a * i2b * 2) + y to a * ((i2b * 2) + 1) + y do hline(0 + x, a + x, i1i);
for i1i := a * ((i2b * 2) + 1) + y to a * ((i2b * 2) + 2) + y do hline(a + 1 + x, (a * 2) + 1 + x, i1i);
end;
x := 2 * (a + 1) + x;
end;
end.
{$f $a0} // fastmul at page $a0 ($a000)
// poszło dopiero przy $70
program benchmark;
uses crt, fastgraph, sysutils;
var x, y, r : byte;
k, v : word;
bmpAdr : word;
start, stop : cardinal;
pawn: array [0..23, 0..23] of byte = (
// $80, $40, $20, $10, $08, $04, $02, $01
...
);
begin
//192 rows of 320 dots in the full screen mode.
InitGraph(8);
SetColor(1);
SetBKColor(82);
TextBackground(80);
bmpAdr := dpeek(88);
start := GetTickCount;
for r := 0 to 7 do begin
for y := 0 to 23 do begin
for x := 0 to 23 do begin
k := bmpAdr + (3 * r) + (y * 40) + x shr 3;
v := peek(k);
poke(k, v or pawn[y][x and %11111]);
end;
end;
end;
stop := GetTickCount;
writeln('drawing time: ', stop - start);
ReadKey;
end.
#!/bin/bash
mp $1.pas -o
if [ -f $1.a65 ]; then
[ ! -d "output" ] && mkdir output
mv $1.a65 output/
fi
#!/bin/bash
if [ -z "$1" ]; then
echo -e "\nPlease call '$0 <argument>' to run this command!\n"
exit 1
fi
mp $1.pas -o
if [ -f "$1.a65" ]; then
[ ! -d "output" ] && mkdir output
mv $1.a65 output/
cd output
mads $1.a65 -x -i:/home/zbyti/Programs/MadPascal/base -o:$1.xex
cd ..
else
exit 1
fi
if [ ! -z "$2" ]; then
atari800 output/$1.xex
fi
build.sh code run
#!/bin/bash
if [ -z "$1" ]; then
echo -e "\nPlease call '$0 <argument>' to run this command!\n"
exit 1
fi
/home/zbyti/Programs/bin/mp $1 -o
name=${1::-4}
fileAsm="${name}.a65"
if [ -f $fileAsm ]; then
[ ! -d "output" ] && mkdir output
mv $fileAsm output/
fi
#!/bin/bash
if [ -z "$1" ]; then
echo -e "\nPlease call '$0 <argument>' to run this command!\n"
exit 1
fi
/home/zbyti/Programs/bin/mp $1 -o
name=${1::-4}
fileAsm="${name}.a65"
if [ -f $fileAsm ]; then
[ ! -d "output" ] && mkdir output
mv $fileAsm output/
cd output
/home/zbyti/Programs/bin/mads $fileAsm -x -i:/home/zbyti/Programs/MadPascal/base -o:$name.xex
cd ..
else
exit 1
fi
if [ ! -z "$2" ]; then
atari800 output/$name.xex
fi
Compile MP [F8] /home/zbyti/Programs/bin/compile.sh "%f"
Compile FPC [F9] fpc "%f"
Execute MP [F5] /home/zbyti/Programs/bin/build.sh "%f" run
Execute FPC [ ] "./%e"
main.c:
// Those weights are chosen by genetic algorithm and then a bit tuned by me0 -+
1 +- wiersz 8 szachownicy
2 -+
0 -+
1 +- wiersz 7 szachownicy
2 -+
...
0 -+
1 +- wiersz 1 szachownicy
2 -+
ABC
DEF
GHI
012
012
012
chessmanPawnW : string = '@((((((((((((((((((((()H((+X((+X(()H((+X((/`((/`((+X(()H(()H((+X((+X((Gf((Gf(';
chessmanPawnB : string = '@((((((((((((((((()H((*8((,0((,0((*8((,0((0,((0,((,0((*8((*8((,0((D6((H)((H)(';
