Modulių mokymąsis

Po rugsėjo-spalio kryžiukų-nuliukų bei kėlinių "laisvalaikio" (t.y. pats sau) programų, kurį laiką nieko neprograminau. Tačiau iki semestro pabaigos pasimokėme funkcijas, procedūras, rodykles (dar nepripratau prie jų), sąrašus (dar neįsiliejo į kraują ir nenaudoju), modulius (primityvi tema).

Modulis tai praktiškai yra atskirai kompiliuojamas failas su įvairiomis procedūromis ir funkcijomis, na kaip biblioteka, į kurią gali kreiptis Pagrindinė programa.
Pateiksiu pavyzdį Pagrindinės programos, ji vadinsis "start", ir kreipsis į modulio (pavadinimas "modu2") funkcijas ir procedūras, o Pagrindinės progr. pradžioje turi būti sakinys "uses modu2" (naudoti modulį "modu2").

Šį modulį pasirašiau per porą dienų, ruošdamasis Diskrečiųjų struktūrų egzaminui.
Diskrečiųjų struktūrų (daug aritmetikos su pirminiais skaičiais ir pnš.) namų darbuose būdavo užduočių, kaip surasti DBD ar MBK iš kelių skaičių, ir suradus juos, norėjosi pasitikrinti, ar tai padariau teisingai. Tas pats su Ferma algoritmu, ar Oilerio funkcija... Tad kiekvienam atvejui pasirašiau funkcijų ar procedūrų, be to kai kada vienos funkcijos(procedūros) kreipiasi į kitas...

Norint pasitikrinti namų darbų rezultatus,
vienas iš būdų buvo paimti skaičiuotuvą ir per ~5 minutes susitikrinti visus atsakymus.
Antras variantas buvo parašyti šitą modulį, per porą vakarų. Man prie širdies buvo antras variantas.

Taigi, "start":

program start;
uses crt, modu2;
var x,z:integer; y,l:longint;

begin
clrscr;

syst;
sistema;
DBD(x);
writeln(x);
MBK;
writeln('iveskite dar sk');
readln(y);
Ferma(y);
writeln(pseudosaknis(y));
writeln('fi: ',fi(y));
writeln(dalikliuSk(y));
dalikliai(y);
writeln;
kanoniuke(y);
readln;
end.

Ir "start" programos įrankių modulis "modu2":

unit modu2;
interface

procedure sys;
function ord16(sk1:byte):byte;
function strlen(st1:string):byte;
procedure sys16(sk1:byte; st1:string; var sk2:longint);
procedure syst;
procedure sistema;
procedure Ferma(sk1:integer);
function DBD2(sk1,sk2:integer):integer;
function MBK2(sk1,sk2:integer):integer;
procedure DBD(var sk1:integer);
procedure MBK;
function pseudosaknis(sk1:longint):longint;
function dalikliuSk(sk1:longint):byte;
function fi(sk1:longint):longint;
procedure dalikliai(sk1:longint);
procedure kanonine(sk1:longint);
procedure kanoniuke(sk1:longint);
function fakt(sk1:integer):longint;
procedure Pfakt(sk1:integer; var sk2:longint);
function max(sk1,sk2,sk3:integer):integer;
procedure nelyg(tiek:byte);
procedure kreipt(k:byte);
implementation

procedure sys;
var a:integer; c:char;
begin
c:='f';
a:=ord(c);
writeln(a);
end;

function ord16(sk1:byte):byte;
var a,j:byte;
begin
if sk1<97 then
begin
for j:=48 to 57 do
begin
if sk1=j then a:=sk1-48;
end;
end
else
begin
j:=96;
repeat
begin
j:=j+1;
end;
until sk1=j;
a:=sk1-97+10;
end;
ord16:=a;
end;

function strlen(st1:string):byte;
var i:byte; b:boolean;
begin
i:=0;
b:=false;
repeat
if st1[i]=' ' then b:=true;
i:=i+1;
until (b=true) or (i=255);
strlen:=i-2;
end;

procedure sys16(sk1:byte; st1:string; var sk2:longint);
var a,b,c,i:byte; d,j:longint;
begin
j:=1;
d:=0;
a:=strlen(st1); // F
writeln('strlen: ',a); // pagalba
for i:=a downto 1 do
begin
b:=ord(st1[i]);
c:=ord16(b); // F
d:=d+c*j;
j:=j*sk1;
writeln(i,' i ',b,' b ',c,' c ',d,' d ',j,' j'); //pagalba
end;
sk2:=d;
end;

procedure syst;
var a,c:byte; f:longint; e:string;
begin
writeln('iveskite skaiciavimo sistemos skaiciu (nuo 4 iki 16)');
writeln('ir iveskite tos sk. sistemos skaiciu (1-ffff)(naudokite tik mazasias raides)');
readln(a);
readln(e);
writeln(a);
writeln(e);
writeln('i kokia skaiciavimo sistema konvertuoti ivesta skaiciu (nuo 4 iki 16)?');
readln(c);
sys16(a,e,f);
writeln('jusu ivestos sk.sistemos ir jos skaiciaus atitikmuo 10-aineje: ',f);
end;

procedure sistema;
var a,b,c,d,n,p:longint;
begin
writeln('iveskite skaiciavimo sistemos skaiciu (nuo 3 iki 10)');
writeln('ir iveskite tos sk. sistemos skaiciu (1-9999)');
readln(a,b);
writeln('i kokia skaiciavimo sistema konvertuoti ivesta skaiciu (nuo 3 iki 10)?');
readln(c);
d:=0;
n:=1;
repeat
begin
p:=b mod 10;
d:=d+p*n;
n:=n*a;
b:=b div 10;
end;
until b < a;
d:=d+b*n;

a:=0;
n:=1;
repeat
begin
p:=d mod c;
a:=a+p*n;
n:=n*10;
d:=d div c;
end;
until d < c;
a:=a+d*n;
writeln('atsakymas: ',a);
end;

procedure Ferma(sk1:integer);
var i,k,l,r,a:integer; m,j,c: real; b:boolean;
begin
i:=1;
r:=trunc(sqrt(sk1));
c:=sqrt((sk1-3)/2);
b:=false;
while i < trunc(c) do
begin
a:=(sqr(r+i));
i:=i+1;
j:=sqrt(a-sk1);
m:=j-round(j);
if abs(m) < 0.01 then
begin
k:=round(sqrt(a)-j);
l:=round(sqrt(a)+j);
i:=trunc(c)+1;
b:=true;
end;
end;
if b=true then writeln('nepirminis: ',sk1,'=',k,'*',l) else writeln('pirminis');
end;

function DBD2(sk1,sk2:integer):integer;
var i:integer;
begin
if sk1<>0 do
begin
i:=sk1 mod sk2;
sk1:=sk2;
sk2:=i;
end;
DBD2:=sk1;
end;

function MBK2(sk1,sk2:integer):integer;
var i:integer;
begin
i:=DBD2(sk1,sk2);
MBK2:=(sk1 div i)*sk2;
end;

procedure DBD(var sk1:integer);
var i,n:byte; a,b: integer;
begin
writeln('kiek skaiciu (nuo 2 iki 10) ivesite??');
readln(n);
n:=n-1;
writeln('dabar juos iveskite');
readln(b);
for i:=1 to n do
begin
readln(a);
b:=DBD2(b,a);
end;
sk1:=b;
end;

procedure MBK;
var i,n:byte; a,b: integer;
begin
writeln('kiek skaiciu (nuo 2 iki 10) ivesite??');
readln(n);
n:=n-1;
writeln('dabar juos iveskite');
readln(b);
for i:=1 to n do
begin
readln(a);
b:=MBK2(b,a);
end;
writeln('MBK: ',b);
end;

function pseudosaknis(sk1:longint):longint;
var j,i,sk:longint;
begin
j:=1;
sk:=sk1;
repeat
begin
j:=j+1;
i:=sk div j;
end;
until i<=j;
pseudosaknis:=j;
//gauname j:= -[-sqrt(sk1)], pvz. jei 25 tai 5, o jei 26..36 tai 6. NETIESA.
end;

function dalikliuSk(sk1:longint):byte;
var d:byte; i,j,r,sk:longint;
begin
j:=1;
d:=0;
sk:=sk1;
repeat
begin
j:=j+1;
i:=sk div j;
end;
until i<=j;

i:=2;
while i <= j do
begin
r:=sk mod i;
if r=0 then
begin
sk:=sk div i;
i:=i-1;
d:=d+1;
end;
i:=i+1;
end;
if sk>j then d:=d+1;
dalikliuSk:=d;

end;

function fi(sk1:longint):longint;
var d,i,j,r,sk,f:longint;
begin
j:=1;
d:=sk1;
f:=sk1;
sk:=sk1;
repeat
begin
j:=j+1;
i:=sk div j;
end;
until i<=j;

i:=2;
while i <= j do
begin
r:=sk mod i;
if r=0 then
begin
f:=(f*(d-(d div i))) div d;
end;
while r=0 do
begin
sk:=sk div i;
r:=sk mod i;
end;
i:=i+1;
end;

d:=sk;
i:=2;
while i <= j do
begin
r:=sk mod i;
if r=0 then
begin
sk:=sk div i;
i:=i-1;
end;
i:=i+1;
end;

if sk>j then f:=(f*(d-(d div sk))) div d;
fi:=f;

end;

procedure dalikliai(sk1:longint);
var i,j,r,sk:longint;
begin
j:=1;
sk:=sk1;
repeat
begin
j:=j+1;
i:=sk div j;
end;
until i<=j;

i:=2;
while i <= j do
begin
r:=sk mod i;
if r=0 then
begin
sk:=sk div i;
write(i,' ');
i:=i-1;
end;
i:=i+1;
end;
if sk>j then write(sk,' ');
end;


procedure kanonine(sk1:longint);
var d,n:byte; i,j,r,sk:longint;
begin
j:=1;
d:=0;
sk:=sk1;
repeat
begin
j:=j+1;
i:=sk div j;
end;
until i<=j;

i:=2;
write(' 1^0 ');
while i <= j do
begin
r:=sk mod i;
if r=0 then d:=d+1 else begin n:=d; d:=0 end;
if r=0 then
begin
sk:=sk div i;
i:=i-1;
end;
if d=0 then write('*',i:4,'^',n,' ');
i:=i+1;
end;
if sk>j then write('*',sk:4,'^',1,' ');
end;

procedure kanoniuke(sk1:longint);
var d,n:byte; i,j,r,sk:longint;
begin
j:=1;
d:=0;
sk:=sk1;
repeat
begin
j:=j+1;
i:=sk div j;
end;
until i<=j;

i:=2;
write('1 ');
while i <= j do
begin
r:=sk mod i;
if r=0 then d:=d+1 else begin n:=d; d:=0 end;
if r=0 then
begin
sk:=sk div i;
i:=i-1;
end;
if (d=0) and (n>0) then write('*',i,'^',n,' ');
i:=i+1;
end;
if sk>j then write('*',sk:4,'^',1,' ');
end;


function fakt(sk1:integer):longint;
var i:byte; c:longint;
begin
if sk1>12 then
begin
sk1:=12;
writeln('longint reiksme mazesne uz 13!, todel pateikiamas 12!');
end;
c:=1;
for i:=1 to sk1 do
begin
c:=c*i;
end;
fakt:=c;
end;

procedure Pfakt(sk1:integer; var sk2:longint);
var i:byte; c:longint;
begin
if sk1>12 then
begin
sk1:=12;
writeln('longint reiksme mazesne uz 13!, todel pateikiami');
writeln('tik faktorialai skaiciu nuo 1 iki 12.');
end;
c:=1;
for i:=1 to sk1 do
begin
c:=c*i;
writeln(i,'! = ',c);
end;
sk2:=c;
end;

function max(sk1,sk2,sk3:integer):integer;
begin
if sk2>sk1 then sk1:=sk2;
if sk3>sk1 then sk1:=sk3;
max:=sk1;
end;

procedure nelyg(tiek:byte);
var i:byte;
begin
for i:=1 to tiek do
writeln(i*2-1);
end;

procedure kreipt(k:byte);
begin
nelyg(k);
end;
initialization
writeln('modu2 startavo');
finalization
writeln('modu2 baige darba');
end.

Kelios universitetinės programos

Pavyzdys vienos iš pirmųjų (gana paprastų) programų, kurias reikėjo parašyti per Pascal'io laborus (sąlyga komentare, t.y. figūriniuose skliaustuose):

Program skaiciu_seka;
{A) Sekos pabaigos požymis: bet kuris skaicius,
kuris didesnis už prieš tai ivesta skaiciu (jis
priklauso sekai);
B) „Statistika“: didžiausias skirtumas tarp
gretimu sekos nariu.}
var a, b, maX, y :integer;
begin
read(a);
read(b);
maX:=a-b;
while a>=b do
begin
y:=a-b;
if y>=maX then maX:=y;
a:=b;
writeln('ivesk dar sk.: ');
read(b);
end;
writeln('didziausias skirtumas yra: ', maX);
end.


Vėliau mokėmės masyvus, ir juos supratau gana greitai ir ėmiau dažnai naudoti: nereikai rašyti daug "copy+paste", ir nereikia kurti krūvas įvairių kintamųjų.
Štai programos, kuri prašo suvesti 4x4 matricos elementus, ir kuri išrenka MAX ir MIN skaičių iš stulpelių, kodas (2010-10-03):

program gyvas_masyvas_RS_2010_10_03;
const N=4;
e=3;
var A: array [1..N] of array [1..N] of integer;
B: array [1..N] of integer; {max}
C: array [1..N] of integer; {min}
i,j : byte;

begin

for i:=1 to N do
begin
for j:=1 to N do
read(A[i][j]) ;
writeln;
end;

for i:=1 to N do
for j:=1 to N do
if j< A[i][j] then B[j]:=A[i][j];

for i:=2 to N do
for j:=1 to N do
if C[j] > A[i][j] then C[j]:=A[i][j];

writeln;
writeln('Didziausios reiksmes stulpeliuose: ');

for j:=1 to N-1 do
write(B[j]:e);
writeln(B[j+1]:e);

writeln('Maziausios reiksmes stulpeliuose: ');

for j:=1 to N-1 do
write(C[j]:e);
writeln(C[j+1]:e);

readln;
readln;

end.

Programa: Kėlinys

Pradėjus mokytis tiesinės algebros ir geometrijos ("dievų kalbos"), viena iš mažyčių paliestų temų buvo kėliniai (toks kombinatorinis "kratinys").

Tai vat, žemiau pateikta programa ir skirta iškratyti atsitiktinio išsidėstymo kėlinį, t.y. eilę nepasikartojančių (n) skaitmenų. O programa parašyta vėlgi daug naudojant "copy+paste" technologiją.

2010-09-23, kėlinys:

program KELINYS_12;
uses crt;
var a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,i,m,n:byte;
k:integer;
begin
clrscr;
randomize;

writeln('2010-09-23 RS. KELINYS_12');
writeln('Programa generuoja atsitiktini KELINI nuo 1 iki 12 eiles');
writeln('Iveskite KELINIO eile:');
readln(n);

i:=0;
a1:=0;a2:=0;a3:=0;a4:=0;
a5:=0;a6:=0;a7:=0;a8:=0;
a9:=0;a10:=0;a11:=0;a12:=0;

if (n>0) and (n<13)
then
begin
write('(');
repeat
begin
k:=i;

m:=random(n)+1;
if (m=1) and (a1<>1) then
begin
write(m);
a1:=1;
i:=i+1;
end;
if (m=2) and (a2<>1) then
begin
write(m);
a2:=1;
i:=i+1;
end;
if (m=3) and (a3<>1) then
begin
write(m);
a3:=1;
i:=i+1;
end;
if (m=4) and (a4<>1) then
begin
write(m);
a4:=1;
i:=i+1;
end;
if (m=5) and (a5<>1) then
begin
write(m);
a5:=1;
i:=i+1;
end;
if (m=6) and (a6<>1) then
begin
write(m);
a6:=1;
i:=i+1;
end;
if (m=7) and (a7<>1) then
begin
write(m);
a7:=1;
i:=i+1;
end;
if (m=8) and (a8<>1) then
begin
write(m);
a8:=1;
i:=i+1;
end;
if (m=9) and (a9<>1) then
begin
write(m);
a9:=1;
i:=i+1;
end;
if (m=10) and (a10<>1) then
begin
write(m);
a10:=1;
i:=i+1;
end;
if (m=11) and (a11<>1) then
begin
write(m);
a11:=1;
i:=i+1;
end;
if (m=12) and (a12<>1) then
begin
write(m);
a12:=1;
i:=i+1;
end;
if (i<>n) and (i>k) then write(',');
end;
until i=n;
writeln(')');

end
else writeln('Tokios eiles KELINIO programa negeneruoja');

readkey;

end.

Programos nuo 2010 rudens. Kryžiukai-nuliukai

2010-10-02 suprograminau kryžiukus-nuliukus, t.y. žaidimas kryžiukai-nuliukai su nepatogiu valdymu, prieš kompiuterį, kuris ėjimus daro randomu į bet kurį laisvą langelį.
Vėliau pridėjau kompiuteriui "proto", ir jis dabar sugeba "nužvelgti" jūsų mintis vienu ėjimu į priekį, ir jeigu mato grėsmę pralaimėti sekančiu ėjimu, tai bando tam priešintis, tačiau pats naudingų progų neišnaudoja...

Programa parašyta su labai daug teksto kartojimo (ctrl+C, ctrl+V) , dėl to ir kodas išėjo ilgas.

Taigi:

program XO;
uses crt;
var a,a11,a12,a13,a21,a22,a23,a31,a32,a33:byte;
e,r,n:byte;
c,c11,c12,c13,c21,c22,c23,c31,c32,c33:byte;
begin
randomize;
clrscr;

e:=0; {e - "error flag"}
r:=0; {r - "result flag"}
n:=0; {n - "overflow" skaitliukas. Pildosi tol, kol pasiekia 9 - maksimalá lentos langeliø skaièiø}
c:=0; {c - intelektas}

a11:=0;
a12:=0;
a13:=0;
a21:=0;
a22:=0;
a23:=0;
a31:=0;
a32:=0;
a33:=0;

c11:=0;
c12:=0;
c13:=0;
c21:=0;
c22:=0;
c23:=0;
c31:=0;
c32:=0;
c33:=0;

writeln('2010-10-02 RS');
writeln('Zaidimas "Kryziukai-nuliukai"');
writeln;
writeln('Tokia tvarka sunumeruoti lentos eilutes ir stulpeliai: ');
writeln(' 1 2 3 ');
writeln(' |---|---|---|');
writeln('1 | | | |');
writeln(' |---|---|---|');
writeln('2 | | | |');
writeln(' |---|---|---|');
writeln('3 | | | |');
writeln(' |---|---|---|');

writeln('Ejimas daromas parasant dvizenkli skaiciu, kurio pirmasis skaitmuo reiskia ');
writeln('eilutes numeri, o antrasis - stulpelio numeri.');
writeln('Pirmieji einate jus (kryziukai). Kompiuteris (nuliukai) atsako automatiskai.');
writeln('Pradekite:');


while (r<1) and (n<>9) do
begin
e:=0;
if n mod 2 = 0 then read(a)
else
begin
if c=11 then a:=11;
if c=22 then a:=22;
if c=33 then a:=33;
if c=12 then a:=12;
if c=21 then a:=21;
if c=13 then a:=13;
if c=23 then a:=23;
if c=31 then a:=31;
if c=32 then a:=32;


if c=0 then
begin
a:=random(9);
a:=(a div 3 + 1)*10 + (a mod 3 + 1);
end;
end;;
n:=n+1;

if not ((a=11) or (a=12) or (a=13) or (a=21) or (a=22) or (a=23) or (a=31) or (a=32) or (a=33)) then e:=1;



if a=11
then if a11=0
then if n mod 2 = 1
then a11:=1
else a11:=4
else e:=1;
if a=12
then if a12=0
then if n mod 2 = 1
then a12:=1
else a12:=4
else e:=1;
if a=13
then if a13=0
then if n mod 2 = 1
then a13:=1
else a13:=4
else e:=1;
if a=21
then if a21=0
then if n mod 2 = 1
then a21:=1
else a21:=4
else e:=1;
if a=22
then if a22=0
then if n mod 2 = 1
then a22:=1
else a22:=4
else e:=1;
if a=23
then if a23=0
then if n mod 2 = 1
then a23:=1
else a23:=4
else e:=1;
if a=31
then if a31=0
then if n mod 2 = 1
then a31:=1
else a31:=4
else e:=1;
if a=32
then if a32=0
then if n mod 2 = 1
then a32:=1
else a32:=4
else e:=1;
if a=33
then if a33=0
then if n mod 2 = 1
then a33:=1
else a33:=4
else e:=1;



clrscr;


writeln(' 1 2 3 ');
writeln(' |---|---|---|');
write('1 | ');
if a11=0 then write(' ') else if a11=1 then write('X') else write('O');
write(' | ');
if a12=0 then write(' ') else if a12=1 then write('X') else write('O');
write(' | ');
if a13=0 then write(' ') else if a13=1 then write('X') else write('O');
writeln(' |');
writeln(' |---|---|---|');
write('2 | ');
if a21=0 then write(' ') else if a21=1 then write('X') else write('O');
write(' | ');
if a22=0 then write(' ') else if a22=1 then write('X') else write('O');
write(' | ');
if a23=0 then write(' ') else if a23=1 then write('X') else write('O');
writeln(' |');
writeln(' |---|---|---|');
write('3 | ');
if a31=0 then write(' ') else if a31=1 then write('X') else write('O');
write(' | ');
if a32=0 then write(' ') else if a32=1 then write('X') else write('O');
write(' | ');
if a33=0 then write(' ') else if a33=1 then write('X') else write('O');
writeln(' |');
writeln(' |---|---|---|');
{ writeln(a11,' ',a12,' ',a13);
writeln(a21,' ',a22,' ',a23);
writeln(a31,' ',a32,' ',a33);}


if e=1 then n:=n-1;
if e=1 then if n mod 2 = 0 then writeln('Klaida. Iveskite koordinate is naujo');

if a11+a12+a13=3 then r:=3;
if a21+a22+a23=3 then r:=3;
if a31+a32+a33=3 then r:=3;
if a11+a21+a31=3 then r:=3;
if a12+a22+a32=3 then r:=3;
if a13+a23+a33=3 then r:=3;
if a11+a22+a33=3 then r:=3;
if a13+a22+a31=3 then r:=3;

if a11+a12+a13=12 then r:=12;
if a21+a22+a23=12 then r:=12;
if a31+a32+a33=12 then r:=12;
if a11+a21+a31=12 then r:=12;
if a12+a22+a32=12 then r:=12;
if a13+a23+a33=12 then r:=12;
if a11+a22+a33=12 then r:=12;
if a13+a22+a31=12 then r:=12;

c:=0;
if (a33=0) then if (a11=1) and (a22=1) then c:=33;
if (a33=0) then if (a31=1) and (a32=1) then c:=33;
if (a33=0) then if (a13=1) and (a23=1) then c:=33;

if (a11=0) then if (a22=1) and (a33=1) then c:=11;
if (a11=0) then if (a21=1) and (a12=1) then c:=11;
if (a11=0) then if (a31=1) and (a13=1) then c:=11;

if (a13=0) then if (a31=1) and (a22=1) then c:=13;
if (a13=0) then if (a11=1) and (a12=1) then c:=13;
if (a13=0) then if (a23=1) and (a33=1) then c:=13;

if (a31=0) then if (a22=1) and (a13=1) then c:=31;
if (a31=0) then if (a11=1) and (a21=1) then c:=31;
if (a31=0) then if (a32=1) and (a33=1) then c:=31;

if (a21=0) then if (a11=1) and (a31=1) then c:=21;
if (a21=0) then if (a22=1) and (a23=1) then c:=21;

if (a12=0) then if (a11=1) and (a13=1) then c:=12;
if (a12=0) then if (a32=1) and (a22=1) then c:=12;

if (a23=0) then if (a21=1) and (a22=1) then c:=23;
if (a23=0) then if (a13=1) and (a33=1) then c:=23;

if (a32=0) then if (a12=1) and (a22=1) then c:=32;
if (a32=0) then if (a31=1) and (a33=1) then c:=32;

if (a22=0) then if (a11=1) and (a33=1) then c:=22;
if (a22=0) then if (a13=1) and (a31=1) then c:=22;
if (a22=0) then if (a21=1) and (a23=1) then c:=22;
if (a22=0) then if (a12=1) and (a32=1) then c:=22;


end;


if r=0 then writeln('Rezultatas: Lygios');
if r=3 then writeln('Rezultatas: jus laimejote. Plojimai!');
if r=12 then writeln('Rezultatas: kompiuteris laimejo. Kokia geda!');

readln;
readln;

end.

"Priešistorė", III dalis

Žemiau pateikiu "baisią" programą, kurią rašiau pamenu nemažai laiko.
Apskritai, buvau pamiršęs ir nemokėjau susiveikti grafinės aplinkos, tai teko pasitenkinti ASCII grafika, t.y. simbolių grafika.
Programos kodas toks baisus, kad pats nedrįsčiau dabar skirti valandos laiko jo perpratimui.
2008-10-08.
Programos mintis buvo gauti "materialų tašką", kuris turėdamas tam tikrą greitį, galėtų judėti stačiakampėje plokštumoje tam tikra (reikia įvesti) kryptimi.
Dar įdėjau programoje "navarotą" - pyptelėjimą po kiekvieno "materialiojo taško" pasislinkimo (žingsnio). O "grafika" atnaujinama dirbtinai, užpildant ekraną tūkstančių eilės skaičiumi vienodų "tuštumą reiškiančių" simbolių :) .

Vualia:

program entr1;
uses crt;
var a,e,f,b,c,c1,c2,c3,d,ax,adx,ay,ady,o,m,n,k,l,p,r,s,t,u,v:integer;
begin
clrscr;
randomize;

writeln('Raide lauke 2008-10-08 (pradzia - spauskite "2" ir "Enter")');

c1:=2;
c2:=5;
c3:=3;
textcolor(c2);

readln(o);
if o=2
then
begin

ax:=random(20)-10;
ay:=random(20)-10;

end;

ax:=40;
ay:=12;
adx:=0;
ady:=0;
m:=0;
repeat
delay(300);
m:=m+1;
begin

clrscr;

end;

ay:=ay+ady;
if ay<2 then ady:=-ady;
if ay>24 then ady:=-ady;
if ay<1 then ay:=1;
if ay>25 then ay:=25;
u:=0;
if ay<>1 then
repeat
u:=u+1;
if u=1 then textcolor(c1) else textcolor(c2);
begin

v:=0;
repeat
v:=v+1;
if v=1 then textcolor(c1);
if v=80 then textcolor(c1);
if u=1 then textcolor(c1);
write('_');
textcolor(c2);
until v=80;

end;

until u=ay-1;

e:=0;
begin

ax:=ax+adx;
if ax<2 then adx:=-adx;
if ax>79 then adx:=-adx;
if ax>80 then ax:=80;
if ax<1 then ax:=1;
n:=0;
if ax<>1 then
repeat
e:=e+1;
if e=1 then textcolor(c1) else textcolor(c2);

write('_');
until e=ax-1;
textcolor(c3);
write('H');
textcolor(c2);
if ax<>80 then
repeat
e:=e+1;
if e=79 then textcolor(c1) else textcolor(c2);
write('_');
until e=79;

end;

if u<24 then
repeat
u:=u+1;

begin

v:=0;
repeat
v:=v+1;
if v=1 then textcolor(c1);
if v=80 then textcolor(c1);
if u=24 then textcolor(c1);
write('_');
textcolor(c2);
until v=80;

end;
textcolor(c2)
until u=24;
delay(300);

if m=1 then
begin
writeln;
textcolor(3);
writeln('Raide stovi lauke 80x25. Iveskite judejimo vektorius x,y (svekuosius)');
readln(adx);
readln(ady);
textcolor(c2);
end;

until m=20;

readln;

end.

"Priešistorė", II dalis

Čia pateikiu 2008-10-11 programą, kuri verčia jūsų įrašytą šešioliktainės skaičiavimo sistemos skaičių į visas kitas skaičiavimo sistemas nuo 2 iki 15.
Šešioliktainį skaičių reikia rašyti priekyje jo rašant dolerio ženklą. Galima pabandyti įrašyti, pvz. $10 ar $f (programa realizuota mažosioms raidėms).













program skaic_sis;
uses crt;

var a,b,c,d,e,f,g,h,i,j:longint;
k,l,m,n,o,p,r:real;

begin
clrscr;

writeln('2008-10-11');
writeln('iveskite 16-aini skaiciu c (pries skaiciu rasomas "$" zenklas)');
readln(c);
e:=1;
repeat
e:=e+1;
f:=$1;
b:=$0;
g:=$0;
d:=$1;
while d<>$0 do
begin
g:=g+$1;
h:=$1;
d:=c;
while h<>g do
begin
h:=h+$1;
d:=d div e;
end;
a:=d mod e;
b:=b+a*f;
f:=f*10;
end;
writeln('b=',b);
until e=$F;

readkey;
end.


O čia tą pačią dieną parašyta "Matmintinio" tipo programėlė, kuri prašo sudėti random du skaičius, o sudėjus penketą tokių iš eilės teisingai, pereinama į "antrą lygį", kur jau duodama skaičius sudauginti. Ir tt.. Dar norėjau kažką su kodais sugalvoti, bet nieko logiško, kaip programoje matyti, neišėjo...

program matm1;
uses crt;
label 001,002,003,004,005,006,007,01,02,03,04;

const c1=2;

var a,b,c,d,e,f,g,h,i:real;
a1,a2,a3,a4,a5,a6,b1,b2,b3:integer;

begin
clrscr;
randomize;

writeln('iv pass');

read(a);
b:=1;

while b<5 do
begin
b:=b+1;
c:=a/sqrt(b);

d:=c;

while d>-0.00005 do
begin
d:=d-1;
if d<0.00005 then if d>-0.00005 then
begin
if b=2 then goto 002;
if b=3 then goto 003;

{end
else if d>-0.0005 then
begin
if b=2 then goto 002;
if b=3 then goto 003;}

end;
end;

end;


begin
writeln('1 laiptas. sudekite skaicius: ');
b1:=0;
while b1<5 do
begin
b2:=1000*(b1+1);
a1:=random(b2);
a2:=random(b2);
writeln(a1);
writeln(a2);
a3:=a1+a2;
readln(a4);
writeln(a3,' -teisinga suma');
if a4=a3 then
begin
b1:=b1+1;
writeln;
if b1=5 then
begin
e:=random(20)*sqrt(2);
writeln(e:8:6,' -jusu kodas 2 laiptui');
readkey;
end
end
else goto 01;
end;
end;

002:;
begin
writeln;
writeln('2 laiptas. sudauginkite skaicius: ');
b1:=0;
b2:=15;
b3:=3;
while b1<5 do
begin
b2:=b2+(b1+1);
{writeln(b2,' -b2');}
a1:=random(b2)+b3;
a2:=random(b2)+b3;
writeln(a1);
writeln(a2);
a3:=a1*a2;
readln(a4);
writeln(a3,' -teisinga sandauga');
if a4 = a3 then
begin
b1:=b1+1;
writeln;
if b1=5 then
begin
e:=random(20)*sqrt(3);
writeln(e:8:6,' -jusu kodas 3 laiptui');
readkey;
end;
end
else goto 01;
end;

end;
003:;
begin
writeln;
writeln ('3 laiptas. palyginkite skaicius: ');
b1:=0;
while b1<5 do
begin
b2:=1000*(b1+1);
a1:=random(b2);
a2:=random(b2);
if a1=a2 then a1:=a1+1;
write(a1,' ',a2);
writeln('spauskite: 1-daugiau,3-maziau ');
a3:=a1-a2;
writeln;
readln(a4);
if a4=1 then
begin
if a3>0 then
begin
b1:=b1+1;
if b1=5 then
begin
writeln('TU NUGALEJAI!');
goto 01;
end;
end
else goto 01;
end;
if a4=3 then
begin
if a3<0 then
begin
b1:=b1+1;
if b1=5 then
begin
writeln('TU LAIMEJAI!');
goto 01;
end;
end
else goto 01;
end;
end;
end;
01:;
writeln('zaidimo pabaiga');
writeln('2008-10-11');
readkey;
end.

[beje, čia programinau su LABEL'ais. Tiesiog neteko su jais anksčiau programinti, tai kai išmokau, pabandžiau, nors tik vėliau sužinojau, kad juos naudot - bloga programavimo maniera..]

"Priešistorė", I dalis

Mokiaus Naujininkų vid. mokykloje, tai 10-oje klasėje turėjome mokytoją, kuris taipogi buvo ir mūsų mokyklos svetainės administratorius/tvarkytojas. Jis šiek tiek keistokas mokytojas (tačiau bendrai paėmus, normos ribose), kiek pamenu, nemėgdavo kartotis, tai reiškia, kad iš vieno karto tekdavo įsiminti ką daro toks ir toks užrašas programoje... o tai būdavo šiokia tokia kliūtis mokymuisi. Daugiausia ką išmokome, tai paišyti pyragus, t.y. pateikti į grafinę aplinką ir ten žaisti su pyragais. Nuo to laiko iki šiol daugiau neteko naudotis grafine aplinka, nes po mokyklos, pamiršau, kaip ją susiveikti.
O iki grafinės aplinkos mokėmės pagrindus: sąlygos (if), ciklų (for, while, repeat) sakiniai.
Iš mokyklos laikų savo programų neturiu.

Po mokyklos kartkartėmis parašydavau primityvių programėlių. Pavyzdžiui, prisimenant ciklus ir pnš., parašydavau faktorialo programėlę ar kažką tokio.

Žaisdamas travianą, vietoje ėjimo į specialų puslapį, kuris turėdavo suskaičiuoti karių judėjimo laiką iš įvestų koordinačių, parašiau "traveltime5" programą, nes puslapyje esanti skaičiuoklė kiek pamenu darydavo klaidas (nesu tikras), kuomet buvo įvedami kiek didesni skaičiai. Štai programos kodas (~2008 metai):

program traveltime5;
uses crt;
var a,b,c,d,e,f,g,h,i,j,k,l:integer;
m,n,o,p,r,s:real;

begin
clrscr;

readln(b);
readln(c);
readln(l);
readln(k);

r:=sqrt(c*c+b*b);
if r<=30 then
begin
n:=r/l;
m:=trunc(n);
o:=trunc((n-trunc(n))*60);
p:=(n*60-trunc(n*60))*60;
write(m:2:0,':',o:2:0,':',p:2:0);
end
else
begin
n:=30/l+(r-30)/(l*(1+0.1*k));
m:=trunc(n);
o:=trunc((n-trunc(n))*60);
p:=(n*60-trunc(n*60))*60;
write(m:2:0,':',o:2:0,':',p:2:0);
end;

readkey;
end.

[į programą įvedami: miestų koordinačių (x ir y) skirtumai, kario vieneto greitis, arenos lygis]

, ir analogiška programa "traveltime3", kuri išmeta lentelę atsakymų, tačiau nėra patogi, kuomet reikia skaičiuoti didelius atstumus:

program traveltime3;
uses crt;
var a,b,c,d,e,f,g,h,i,j,k,l:integer;
m,n,o,p,r,s:real;

begin
clrscr;
randomize;
l:=1;

repeat
readln(l);
clrscr;
c:=0;
repeat
c:=c+1;

b:=0;

repeat
b:=b+1;
n:=sqrt(c*c+b*b)/l;
m:=trunc(n);
o:=trunc((n-trunc(n))*60);
p:=(n*60-trunc(n*60))*60;
write(m:2:0,':',o:2:0,':',p:2:0);
until b=10;

until c=20;

until l<1;

readkey;
end.

[įvedamas kario greitis; įvedus 7 (vienas iš dažniausių travian armijų greičių), kaip screenshot'e matosi, mums parodo lentelę, kurioje atsirinkę reikiamą nenulinį stulpelį (1-8) ir nenulinę eilutę (1-20), susirandame karių judėjimo trukmę]



Faktorialo programėlė, parašyta ~2009 metais:

program faktorialas;
uses crt;
var a,b,c,d,e,f,g,h,i,j:longint;
a1:byte;
begin
clrscr;

read(a);
if a>12 then
begin
a:=12;
textcolor(green);
writeln('longint reiksme mazesne uz 13!, todel pateikiama');
writeln('eilute tik faktorialu iki 12!');
textcolor(white);
end;
b:=0;
c:=1;
while b
begin
b:=b+1;
c:=c*b;
write(' ',c);
end;

readkey;
end.