OldComp.cz

Komunitní diskuzní fórum pro fanoušky historických počítačů

DOSDev 2020

Právě je 12.07.2020, 20:51

Všechny časy jsou v UTC + 1 hodina [ Letní čas ]




Odeslat nové téma Odpovědět na téma  [ Příspěvků: 90 ]  Přejít na stránku Předchozí  1, 2, 3, 4, 5, 6
Autor Zpráva
PříspěvekNapsal: 17.05.2020, 08:48 
Offline
Pan Generální
Uživatelský avatar

Registrován: 23.03.2014, 20:13
Příspěvky: 2024
Has thanked: 101 times
Been thanked: 388 times
Kytky můžou být orientované svisle nebo vodorovně:
Příloha:
kytky.png
kytky.png [ 7.61 KiB | Zobrazeno 1050 krát ]

Kód:
procedure kytka(xs,ys,r,v,o:integer);

          var a:real;
              i,x1,y1,x2,y2,x3,y3:integer;

          begin
          if v<2 then v:=2;

          for i:=0 to v do
              begin
              a:=6.2831853*i/v;
              x1:=xs+round(r*cos(a));
              y1:=ys+round(r*sin(a));
              a:=6.2831853*(i+0.5)/v;
              x2:=xs+round(r*cos(a));
              y2:=ys+round(r*sin(a));
              a:=6.2831853*(i+1)/v;
              x3:=xs+round(r*cos(a));
              y3:=ys+round(r*sin(a));

              if 0=(o mod 2) then
                 begin
                 mini(x1,y1,xs,ys,x2,y2);
                 mini(x3,y3,xs,ys,x2,y2)
                 end
              else
                 begin
                 mini(x2,y2,xs,ys,x1,y1);
                 mini(x2,y2,xs,ys,x3,y3)
                 end
              end
          end;

Opět podle sudého nebo lichého čísla v posledním parametru a s ridší konstantou N=20:
Kód:
kytka(1100, 400,350,1,0);
kytka( 400, 600,350,1,1);
kytka(1100,1300,350,4,0);
kytka( 400,1500,350,4,1);


A s tím by už měl jít vykreslit libovolný obrazec ze začátku vlákna.

_________________
"Dokud nebyly počítače, programování nebylo problémem.
Jestliže bylo několik slabých počítačů, bylo programování malým problémem.
Když však programátoři získali počítače na svou dobu ohromné síly, stalo se také programování ohromným problémem."

E. W. Dijkstra, 1972


Nahoru
 Profil  
 
PříspěvekNapsal: 17.05.2020, 09:11 
Offline
Pan Generální
Uživatelský avatar

Registrován: 23.03.2014, 20:13
Příspěvky: 2024
Has thanked: 101 times
Been thanked: 388 times
Tak ještě jedna změna, s tímhle by měly jít vykreslit úplně stejně jako na těch obrázcích:
Kód:
PROCEDURE MINI(X1,Y1,X2,Y2,X3,Y3:INTEGER);

          CONST   J = 50;      (*ROZLISITELNOST KRESBY*)
                  N = 20 {50};      (*DELENI*)

          VAR I,X,Y : INTEGER;

          BEGIN
          QMOVA(X2,Y2);
          FOR I:=1 TO J DO
              BEGIN
              IF I MOD 2=1 THEN      (*KRESLENI JEDNIM TAHEM TAM*)
                 QVECTA(X1,Y1)
              ELSE
                 QVECTA(X3,Y3);
              X :=(X2-X1) DIV N+X1;
              Y :=(Y2-Y1) DIV N+Y1;
              X2:=(X3-X2) DIV N+X2;
              Y2:=(Y3-Y2) DIV N+Y2;
              QVECTA(X2,Y2);
              X3:=(X1-X3) DIV N+X3;
              Y3:=(Y1-Y3) DIV N+Y3;
              X1:=X;
              Y1:=Y;
              IF NOT(I MOD 2=1) THEN   (*KRESLENI JEDNIM TAHEM ZPET*)
                 QVECTA(X1,Y1)
              ELSE
                 QVECTA(X3,Y3)
              END
          END;

Měli tam nesprávné nastavení počátečního bodu kreslení na (X1,Y1) místo (X2,Y2), takže chyběla první čára. U těch rotačních kreseb tvořila vnitřní kříž.
Takže ten QORG klidně mohl být také špatně, chyby útočí ve smečkách :P

_________________
"Dokud nebyly počítače, programování nebylo problémem.
Jestliže bylo několik slabých počítačů, bylo programování malým problémem.
Když však programátoři získali počítače na svou dobu ohromné síly, stalo se také programování ohromným problémem."

E. W. Dijkstra, 1972


Nahoru
 Profil  
 
PříspěvekNapsal: 17.05.2020, 09:16 
Offline
Pan Štábní
Uživatelský avatar

Registrován: 08.07.2013, 00:28
Příspěvky: 1191
Has thanked: 288 times
Been thanked: 316 times
Chválím za přepisy! :like:


Připomíná mi to obrázky kreslené kyblíkem barvy (ideálně ještě s dodatečným závažím, aby to mělo nějakou váhu), na který působí fyzikálními zákony - v angličtině "pendlum painting".

Obrázek

phpBB [video]

https://www.youtube.com/watch?v=9wEQlWo6Ddc

_________________
より良い競争相手からソフトウェアを購入する (。◕‿‿◕。)


Nahoru
 Profil  
 
PříspěvekNapsal: 17.05.2020, 10:05 
Offline
Pan Generální
Uživatelský avatar

Registrován: 23.03.2014, 20:13
Příspěvky: 2024
Has thanked: 101 times
Been thanked: 388 times
Pořád ještě to není úplně přesné. A když tam tu další chybějící čáru dokreslím, tak to zase v tom místě vychází moc hustě.

Ale pokud se v jednom z těch větvení v MINI změní 1 na 0, tak to umí háčkovat dečky! S konstantami J i N na 20:
Příloha:
dečka.png
dečka.png [ 13.8 KiB | Zobrazeno 1036 krát ]

_________________
"Dokud nebyly počítače, programování nebylo problémem.
Jestliže bylo několik slabých počítačů, bylo programování malým problémem.
Když však programátoři získali počítače na svou dobu ohromné síly, stalo se také programování ohromným problémem."

E. W. Dijkstra, 1972


Nahoru
 Profil  
 
PříspěvekNapsal: 17.05.2020, 11:15 
Offline
Profík
Uživatelský avatar

Registrován: 24.05.2018, 22:32
Příspěvky: 837
Bydliště: Most, Praha
Has thanked: 253 times
Been thanked: 216 times
Možná ještě přidat trochu animace?

Obrázek

_________________
i++ (INC) increment
i-- (DEC) decrement
i@@ (EXC) excrement


Nahoru
 Profil  
 
PříspěvekNapsal: 17.05.2020, 11:25 
Offline
Pan Generální
Uživatelský avatar

Registrován: 23.03.2014, 20:13
Příspěvky: 2024
Has thanked: 101 times
Been thanked: 388 times
No pěkné, jenže tohle ten TP pod DOSBoxem nestíhá ani náhodou, a na reálném plotteru bys jednu sekvenci rýsoval možná do zimy :lol:

Co takhle přenést Petra do Linuxu? Na Raspberry Pi by mohl dost slušně konkurovat Scratchi!

_________________
"Dokud nebyly počítače, programování nebylo problémem.
Jestliže bylo několik slabých počítačů, bylo programování malým problémem.
Když však programátoři získali počítače na svou dobu ohromné síly, stalo se také programování ohromným problémem."

E. W. Dijkstra, 1972


Nahoru
 Profil  
 
PříspěvekNapsal: 17.05.2020, 14:17 
Offline
Kecálek

Registrován: 10.07.2014, 01:57
Příspěvky: 107
Has thanked: 8 times
Been thanked: 90 times
faraon píše:
Pořád ještě to není úplně přesné. A když tam tu další chybějící čáru dokreslím, tak to zase v tom místě vychází moc hustě.
skus najskor vykreslit [x1,y1]->[x2,y2] a [x2,y2]->[x3,y3] a az potom vyratavat nove [x1,y1], [x2,y2] a [x3,y3]

v ramci roznorodosti jazykov prikladam ukazku v php ;] (pridana pripona .txt, neviem ci je .php povolene na upload)

EDIT: este.. v tom Tvojom programe bude treba tie prve qvect (na zaciatku cyklu) zmenit na qmove a to qmove este pred cyklom mozes potom vyhodit


Přílohy:
test.php.txt [1.71 KiB]
32 krát
Nahoru
 Profil  
 
PříspěvekNapsal: 18.05.2020, 14:12 
Offline
Kecálek

Registrován: 16.11.2013, 20:07
Příspěvky: 179
Has thanked: 0 time
Been thanked: 77 times
Ještě jsem našel toto:


Přílohy:
carovka.jpg
carovka.jpg [ 22.82 KiB | Zobrazeno 953 krát ]
carovka.pdf [241.09 KiB]
33 krát
Nahoru
 Profil  
 
PříspěvekNapsal: 18.05.2020, 21:54 
Offline
Pan Generální
Uživatelský avatar

Registrován: 23.03.2014, 20:13
Příspěvky: 2024
Has thanked: 101 times
Been thanked: 388 times
Tak jsem to ještě pořádně přežvýkal, okomentoval, odstranil chyby (hlavně moje), doplnil pár drobností, a dosavadní výsledky experimentování rozdělil do šesti různých módů kreslení.
Příloha:
kresby.png
kresby.png [ 31.23 KiB | Zobrazeno 915 krát ]

Příloha:
rotace.png
rotace.png [ 25.45 KiB | Zobrazeno 915 krát ]

Teda, na to že to původně mělo jednapadesát řádků se mi to docela slušně rozlezlo.
Kód:
PROGRAM GRAFIK;
(*CAROVA GRAFIKA*)

uses Graph;



const PIPI = 6.2831853;                         (* 2*PI pro vypocty paprsku *)

VAR karta,rezim:integer;                        (* nastaveni grafiky *)
    qpenx,qpeny,qpenspeed,qJ,qN,qM:integer;     (* promenne plotteru *)



(*****************************************************************************
 * reset listu, smazani vseho
 *)
procedure reset;

          begin
          cleardevice;
          floodfill(0,0,15);
          setcolor(0);
          end;



(*****************************************************************************
 * inicializace pera do pocatecni polohy x,y
 * v rozsahu 0,0..1500,2100
 *)
procedure qorg(x,y:integer);

          begin
          if x<0 then x:=0 else
          if x>1500 then x:=1500;
          if y<0 then y:=0 else
          if y>2100 then y:=2100;

          qpenx:=y;
          qpeny:=x
          end;



(*****************************************************************************
 * nastaveni rychlosti kresleni 0..5
 * 5 = maximalni
 * 1 = minimalni
 * 0 = mimo limit, zelva
 *)
procedure qspeed(r:integer);

          begin
          if r<0 then r:=0 else
          if r>5 then r:=5;

          qpenspeed:=32767;
          while r>0 do
                begin
                qpenspeed:=qpenspeed div 8;
                dec(r)
                end
          end;



(*****************************************************************************
 * posun pera na absolutni pozici x,y
 * v rozsahu 0,0..1500,2100
 *)
procedure qmova(x,y:integer);

          begin
          if x<0 then x:=0 else
          if x>1500 then x:=1500;
          if y<0 then y:=0 else
          if y>2100 then y:=2100;

          qpenx:=x;
          qpeny:=y
          end;



(*****************************************************************************
 * nakresleni cary z aktualni pozice na absolutni x,y
 * okraje papiru nejsou hlidane
 *)
procedure qvecta(x,y:integer);

          var t,w:integer;

          begin
          line(5+qpeny*3 div 10,465-qpenx*3 div 10,5+y*3 div 10,465-x*3 div 10);
          qpenx:=x;
          qpeny:=y;

          (* zpomalovaci smycka *)
          for t:=qpenspeed downto 0 do w:=getgraphmode
          end;



(*****************************************************************************
 * konfigurace procedury MINI
 * qJ = pocet opakovani
 * qN = delitel pro posun
 * qM = mod kresleni
 *)
procedure qconf(j,n,m:integer);

          begin
          if j<1 then qJ:=1 else qJ:=j;
          if n<2 then qN:=2 else qN:=n;
          if m<0 then qM:=0 else qM:=m
          end;



(*****************************************************************************
 * kresleni dvou car ve tvaru L do zmensujici se spiraly
 *)
PROCEDURE MINI(X1,Y1,X2,Y2,X3,Y3:INTEGER);

          CONST   J = 50;              (*ROZLISITELNOST KRESBY*)
                  N = 50;                       (*DELENI*)

          VAR I,X,Y : INTEGER;

          (*******************************************************************
           * 0 = puvodni kreslici rutina
           *)
          procedure mode0;

                    var i:integer;

                    begin
                    QMOVA(X1,Y1);

                    FOR I:=1 TO qJ DO
                        BEGIN
                        IF I MOD 2=1 THEN       (*KRESLENI JEDNIM TAHEM TAM*)
                           QVECTA(X1,Y1)
                        ELSE
                           QVECTA(X3,Y3);
                        X :=(X2-X1) DIV qN+X1;
                        Y :=(Y2-Y1) DIV qN+Y1;
                        X2:=(X3-X2) DIV qN+X2;
                        Y2:=(Y3-Y2) DIV qN+Y2;
                        QVECTA(X2,Y2);
                        X3:=(X1-X3) DIV qN+X3;
                        Y3:=(Y1-Y3) DIV qN+Y3;
                        X1:=X;
                        Y1:=Y;
                        IF NOT(I MOD 2=1) THEN   (*KRESLENI JEDNIM TAHEM ZPET*)
                           QVECTA(X1,Y1)
                        ELSE
                           QVECTA(X3,Y3)
                        END
                    end;

          (*******************************************************************
           * vypocet posunu k dalsimu bodu
           *)
          function posun(a,b:integer):integer;

                   begin
                   posun:=(b-a) DIV qN+a
                   end;

          (*******************************************************************
           * 1 = opraveny zacatek kresleni
           *)
          procedure mode1;

                    var i:integer;

                    begin
                    QMOVA(x3,y3);
                    qvecta(x2,y2);
                    qvecta(X1,Y1);

                    FOR I:=1 TO qJ DO
                        BEGIN
                        IF I MOD 2=1 THEN
                           QVECTA(X1,Y1)
                        ELSE
                           QVECTA(X3,Y3);
                        X :=posun(X1,X2);
                        Y :=posun(Y1,Y2);
                        X2:=posun(X2,X3);
                        Y2:=posun(Y2,Y3);
                        QVECTA(X2,Y2);
                        X3:=posun(X3,X1);
                        Y3:=posun(Y3,Y1);
                        X1:=X;
                        Y1:=Y;
                        IF NOT(I MOD 2=1) THEN
                           QVECTA(X1,Y1)
                        ELSE
                           QVECTA(X3,Y3)
                        END
                    end;

          (*******************************************************************
           * otoci body do dalsi pozice
           *)
          procedure otocit;

                    begin
                    X :=posun(X1,X2);
                    Y :=posun(Y1,Y2);
                    X2:=posun(X2,X3);
                    Y2:=posun(Y2,Y3);
                    X3:=posun(X3,X1);
                    Y3:=posun(Y3,Y1);
                    X1:=X;
                    Y1:=Y
                    end;

          (*******************************************************************
           * 2 = 2 cary tam a zpet
           *)
          procedure mode2;

                    var i:integer;

                    begin
                    FOR I:=1 TO qJ DO
                        BEGIN
                        IF I MOD 2=1 THEN
                           QmovA(X1,Y1)
                        ELSE
                           QmovA(X3,Y3);
                        QVECTA(X2,Y2);
                        IF NOT(I MOD 2=1) THEN
                           QVECTA(X1,Y1)
                        ELSE
                           QVECTA(X3,Y3);
                        otocit
                        END
                    end;

          (*******************************************************************
           * 3 = 3 cary tam a zpet
           *)
          procedure mode3;

                    var i:integer;

                    begin
                    QMOVA(X1,Y1);

                    FOR I:=1 TO qJ DO
                        BEGIN
                        IF I MOD 2=1 THEN
                           QVECTA(X1,Y1)
                        ELSE
                           QVECTA(X3,Y3);
                        QVECTA(X2,Y2);
                        IF NOT(I MOD 2=1) THEN
                           QVECTA(X1,Y1)
                        ELSE
                           QVECTA(X3,Y3);
                        otocit
                        END
                    end;

          (*******************************************************************
           * 4 = trojuhelnikova spirala
           *)
          procedure mode4;

                    var i:integer;

                    begin
                    QMOVA(X1,Y1);

                    FOR I:=1 TO qJ DO
                        BEGIN
                        QVECTA(X2,Y2);
                        otocit;
                        QVECTA(X3,Y3);
                        QVECTA(X1,Y1)
                        END
                    end;

          (*******************************************************************
           * 5 = uplne trojuhelniky
           *)
          procedure mode5;

                    var i:integer;

                    begin
                    FOR I:=1 TO qJ DO
                        BEGIN
                        QMOVA(X1,Y1);
                        QVECTA(X2,Y2);
                        QVECTA(X3,Y3);
                        QVECTA(X1,Y1);
                        otocit
                        END
                    end;

          (*******************************************************************)
          BEGIN
          case qM of
               5:   mode5;
               4:   mode4;
               3:   mode3;
               2:   mode2;
               1:   mode1;
               else mode0
               end
          END;



(*****************************************************************************
 * rotace kytky
 * xs,ys = souradnice stredu
 * r = polomer
 * v = pocet vrcholu
 * o = orientace
 *     0 = nahore hrot
 *     1 = nahore list
 *)
procedure kytka(xs,ys,r,v,o:integer);

          var a:real;
              i,x1,y1,x2,y2,x3,y3:integer;

          begin
          if v<2 then v:=2;

          for i:=1 to v do
              begin
              a:=pipi*(i-1)/v;
              x1:=xs+round(r*cos(a));
              y1:=ys+round(r*sin(a));
              a:=pipi*(i-0.5)/v;
              x2:=xs+round(r*cos(a));
              y2:=ys+round(r*sin(a));
              a:=pipi*i/v;
              x3:=xs+round(r*cos(a));
              y3:=ys+round(r*sin(a));

              if 0=(o mod 2) then
                 begin
                 mini(x1,y1,xs,ys,x2,y2);
                 mini(x3,y3,xs,ys,x2,y2)
                 end
              else
                 begin
                 mini(x2,y2,xs,ys,x1,y1);
                 mini(x2,y2,xs,ys,x3,y3)
                 end
              end
          end;



(*****************************************************************************
 * rotace vetrniku
 * xs,ys = souradnice stredu
 * r = polomer
 * v = pocet vrcholu
 * s = smer
 *     0 = toci doleva
 *     1 = toci doprava
 *)
procedure vetrnik(xs,ys,r,v,s:integer);

          var a:real;
              i,x1,y1,x2,y2:integer;

          begin
          if v<3 then v:=3;

          for i:=1 to v do
              begin
              a:=pipi*(i-1)/v;
              x1:=xs+round(r*cos(a));
              y1:=ys+round(r*sin(a));
              a:=pipi*i/v;
              x2:=xs+round(r*cos(a));
              y2:=ys+round(r*sin(a));

              if 0=(s mod 2) then
                 mini(x1,y1,xs,ys,x2,y2)
              else
                 mini(x2,y2,xs,ys,x1,y1)
              end
          end;



(*****************************************************************************)
BEGIN
writeln;
writeln(' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ');
writeln(' * GRAFIK TURBO, rozsirene demo pro Aritma Minigraf 0507 k IQ151 * ');
writeln(' * ============================================================= * ');
writeln(' *                pro pokracovani mackej ENTER...                * ');
writeln(' * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * ');
readln;

karta:=9;
rezim:=2;
initgraph(karta,rezim,' ');
reset;

QORG(0,0);
QSPEED(5);
qconf(20,20,3);

(* puvodni obrazek *)
MINI(1500,   0, 750, 750, 750, 500);
MINI(   0,   0, 750, 750, 750, 500);
MINI(1500,   0, 750, 750, 900,2100);
MINI(   0,   0, 750, 750, 600,2100);
MINI( 900,2100, 750, 750, 750,2100);
MINI( 600,2100, 750, 750, 750,2100);
readln;
reset;

qconf(50,20,5);
mini(   0,   0,   0,2100,1500,2100);
mini(   0,   0,1500,   0,1500,2100);
mini(1500,2100,   0,2100,   0,   0);
mini(1500,2100,1500,   0,   0,   0);
readln;
reset;

qconf(20,10,0);
kytka(1125, 350,350,5,1);
qconf(20,10,1);
kytka( 375, 350,350,5,1);
qconf(20,10,2);
kytka(1125,1050,350,5,1);
qconf(20,10,3);
kytka( 375,1050,350,5,1);
qconf(20,10,4);
kytka(1125,1750,350,5,1);
qconf(20,10,5);
kytka( 375,1750,350,5,1);
readln;
reset;

qconf(20,10,0);
vetrnik(1125, 350,350,5,1);
qconf(20,10,1);
vetrnik( 375, 350,350,5,1);
qconf(20,10,2);
vetrnik(1125,1050,350,5,1);
qconf(20,10,3);
vetrnik( 375,1050,350,5,1);
qconf(20,10,4);
vetrnik(1125,1750,350,5,1);
qconf(20,10,5);
vetrnik( 375,1750,350,5,1);



readln;
closegraph;
END.

Má někdo chuť to přepsat do skutečného íkvéčka? :angel:

To by byly čáry, a teď se možná pokusím i o nějakou elipsu.

_________________
"Dokud nebyly počítače, programování nebylo problémem.
Jestliže bylo několik slabých počítačů, bylo programování malým problémem.
Když však programátoři získali počítače na svou dobu ohromné síly, stalo se také programování ohromným problémem."

E. W. Dijkstra, 1972


Nahoru
 Profil  
 
PříspěvekNapsal: 19.05.2020, 10:44 
Offline
Pan Štábní
Uživatelský avatar

Registrován: 08.07.2013, 00:28
Příspěvky: 1191
Has thanked: 288 times
Been thanked: 316 times
Skvělá práce! :like:

Jen s umísťováním BEGINu a ENDu na stejnou úroveň jako příkazy, které "obklopují," jsem se zatím nesetkal - trochu hůř se to čte...

Kód:
if 0=(o mod 2) then
    begin
    mini(x1,y1,xs,ys,x2,y2);
    mini(x3,y3,xs,ys,x2,y2)
    end;

vs

if 0=(o mod 2) then
begin
    mini(x1,y1,xs,ys,x2,y2);
    mini(x3,y3,xs,ys,x2,y2)
end;

nebo

if 0=(o mod 2) then begin
    mini(x1,y1,xs,ys,x2,y2);
    mini(x3,y3,xs,ys,x2,y2)
end;


Ale to je věc zvyku. Sám mám ošklivý zlozvyk dávat v C++ i C#/CLR prefix "T" u struktur/enumerací a "C" u tříd :hammer: Tak nějak mi ten kód pak přijde intuitivnější...

_________________
より良い競争相手からソフトウェアを購入する (。◕‿‿◕。)


Nahoru
 Profil  
 
PříspěvekNapsal: 19.05.2020, 11:10 
Offline
Profík
Uživatelský avatar

Registrován: 24.05.2018, 22:32
Příspěvky: 837
Bydliště: Most, Praha
Has thanked: 253 times
Been thanked: 216 times
tomascz píše:
...Jen s umísťováním BEGINu a ENDu na stejnou úroveň jako příkazy, které "obklopují," jsem se zatím nesetkal - trochu hůř se to čte...

Na to mi přijdou závorky v C přehlednější, líp to opticky ohraničuje blok.
Kód:
if (0==o%2)
{
    mini(x1,y1,xs,ys,x2,y2);
    mini(x3,y3,xs,ys,x2,y2);
}

if (0==o%2) {
    mini(x1,y1,xs,ys,x2,y2);
    mini(x3,y3,xs,ys,x2,y2);
}

Prefix u tříd a struktur mi nepřijde zlozvyk, odliší se to tak od jmen proměnných.

_________________
i++ (INC) increment
i-- (DEC) decrement
i@@ (EXC) excrement


Nahoru
 Profil  
 
PříspěvekNapsal: 19.05.2020, 19:07 
Offline
Pan Generální
Uživatelský avatar

Registrován: 23.03.2014, 20:13
Příspěvky: 2024
Has thanked: 101 times
Been thanked: 388 times
Whitesmiths: https://www.slant.co/topics/2478/~best-indentation-style-in-c Ale ne tak docela.

Já jsem kdysi vyzkoušel spoustu různých stylů, ale žádný mi úplně nevyhovoval. Pak jsem v jedné prastaré učebnici Algolu narazil právě na tohle, a prakticky na první pohled jsem zjistil že je to právě to co hledám.

Pascal:
Kód:
for i:=1 to 10 do
    begin
    writeln(i)
    end

C:
Kód:
for (i=1;i<=10;++i)
    {
    printf("%d\n",i);
    }

Python:
Kód:
for i in range(1,11):
    print(i)

BASIC:
Kód:
FOR I=1 TO 10
    PRINT I
    NEXT I

Karel:
Kód:
OPAKUJ 5-KRÁT
       KE-ZDI
       VLEVO-VBOK
       KONEC


Od té doby jsem to používal ve všech jazycích, s výjimkou FORTRANu. Ten má svoje děrnoštítkové formátování a nutit mu cokoliv jiného by byla urážka. Naopak třeba v Pythonu mi to moc pomáhá! Má to prosté schéma:

Klíčové slovo - mezera - zarovnaný blok.

A když si z té mezery za klíčovým slovem udělám/myslím čáru dolů, poznám okamžitě co do bloku patří, kde končí, a jaké věci se v něm vnořují. Pro mě je tohle nejpřehlednější, hlavně při čmárání programů ručně na papír :)

P.S: Mimochodem, kopenogramy nejsou ani trochu mrtvá záležitost, naopak jsou dnes mnohem živější než v osmdesátých letech :lol:
Příloha:
Blockly10.png
Blockly10.png [ 5.97 KiB | Zobrazeno 807 krát ]

_________________
"Dokud nebyly počítače, programování nebylo problémem.
Jestliže bylo několik slabých počítačů, bylo programování malým problémem.
Když však programátoři získali počítače na svou dobu ohromné síly, stalo se také programování ohromným problémem."

E. W. Dijkstra, 1972


Nahoru
 Profil  
 
PříspěvekNapsal: 23.05.2020, 13:03 
Offline
Pan Generální
Uživatelský avatar

Registrován: 23.03.2014, 20:13
Příspěvky: 2024
Has thanked: 101 times
Been thanked: 388 times
Konečně je tady i BASICová verze! Jede to v QBasicu, ale neměly by tam snad být žádné nepřenositelné speciality. Akorát to WHILE INKEY$ = "": WEND je čekání na stisk klávesy.
Pochopitelně je ten program mnohem pomalejší a výsledek hnusnější :lol:
Příloha:
QBkresby.png
QBkresby.png [ 31.63 KiB | Zobrazeno 738 krát ]

Příloha:
QBrotace.png
QBrotace.png [ 29.5 KiB | Zobrazeno 738 krát ]

Řádek 30 není nutný, takhle to počítá trochu rychleji. Konstanta na řádku 50 také nemusí být konstantní, stačí proměnná. A snažil jsem se nepoužívat GOTO, až na pár výjimečných případů:
Kód:
10 REM PROGRAM GRAFIK;
20 REM (*CAROVA GRAFIKA*)
30 DEFINT A-Z: DEFSNG U
50 CONST pipi = 6.2831853#: REM (* 2*PI pro vypocty paprsku *)
60 REM vypocet posunu k dalsimu bodu
70 DEF fnp (a, b) = INT((b - a) / qN + a + .5)

100 REM **********************************************************************

110 PRINT " * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *"
111 PRINT " * GRAFIK TURBO, rozsirene demo pro Aritma Minigraf 0507 k IQ151 *"
112 PRINT " * ============================================================= *"
113 PRINT " *                pro pokracovani mackej ENTER...                *"
114 PRINT " * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *"
120 WHILE INKEY$ = "": WEND
130 SCREEN 12: REM graficky rezim 640x480
140 GOSUB 999
150 a = 0: b = 0: GOSUB 1000: REM QORG(0,0);
160 a = 5: GOSUB 1100: REM QSPEED(5);

200 a = 20: b = 20: c = 3: GOSUB 1400
201 REM (* puvodni obrazek *)
202 a = 1500: b = 0:    c = 750: d = 750: e = 750: f = 500:  GOSUB 1500
203 a = 0:    b = 0:    c = 750: d = 750: e = 750: f = 500:  GOSUB 1500
204 a = 1500: b = 0:    c = 750: d = 750: e = 900: f = 2100: GOSUB 1500
205 a = 0:    b = 0:    c = 750: d = 750: e = 600: f = 2100: GOSUB 1500
206 a = 900:  b = 2100: c = 750: d = 750: e = 750: f = 2100: GOSUB 1500
207 a = 600:  b = 2100: c = 750: d = 750: e = 750: f = 2100: GOSUB 1500
208 WHILE INKEY$ = "": WEND
209 GOSUB 999

300 a = 50: b = 20: c = 5: GOSUB 1400: REM qconf();
301 a = 0:    b = 0:    c = 0:    d = 2100: e = 1500: f = 2100: GOSUB 1500
302 a = 0:    b = 0:    c = 1500: d = 0:    e = 1500: f = 2100: GOSUB 1500
303 a = 1500: b = 2100: c = 0:    d = 2100: e = 0:    f = 0:    GOSUB 1500
304 a = 1500: b = 2100: c = 1500: d = 0:    e = 0:    f = 0:    GOSUB 1500
305 WHILE INKEY$ = "": WEND
306 GOSUB 999

400 a = 20:   b = 10:   c = 0:                 GOSUB 1400
401 a = 1125: b = 350:  c = 350: d = 5: e = 1: GOSUB 1800
402 a = 20:   b = 10:   c = 1:                 GOSUB 1400
403 a = 375:  b = 350:  c = 350: d = 5: e = 1: GOSUB 1800
404 a = 20:   b = 10:   c = 2:                 GOSUB 1400
405 a = 1125: b = 1050: c = 350: d = 5: e = 1: GOSUB 1800
406 a = 20:   b = 10:   c = 3:                 GOSUB 1400
407 a = 375:  b = 1050: c = 350: d = 5: e = 1: GOSUB 1800
408 a = 20:   b = 10:   c = 4:                 GOSUB 1400
409 a = 1125: b = 1750: c = 350: d = 5: e = 1: GOSUB 1800
410 a = 20:   b = 10:   c = 5:                 GOSUB 1400
411 a = 375:  b = 1750: c = 350: d = 5: e = 1: GOSUB 1800
412 WHILE INKEY$ = "": WEND
413 GOSUB 999

500 a = 20:   b = 10:   c = 0:                 GOSUB 1400
501 a = 1125: b = 350:  c = 350: d = 5: e = 1: GOSUB 1900
502 a = 20:   b = 10:   c = 1:                 GOSUB 1400
503 a = 375:  b = 350:  c = 350: d = 5: e = 1: GOSUB 1900
504 a = 20:   b = 10:   c = 2:                 GOSUB 1400
505 a = 1125: b = 1050: c = 350: d = 5: e = 1: GOSUB 1900
506 a = 20:   b = 10:   c = 3:                 GOSUB 1400
507 a = 375:  b = 1050: c = 350: d = 5: e = 1: GOSUB 1900
508 a = 20:   b = 10:   c = 4:                 GOSUB 1400
509 a = 1125: b = 1750: c = 350: d = 5: e = 1: GOSUB 1900
510 a = 20:   b = 10:   c = 5:                 GOSUB 1400
511 a = 375:  b = 1750: c = 350: d = 5: e = 1: GOSUB 1900



989 WHILE INKEY$ = "": WEND: SCREEN 0: END

990 REM **********************************************************************
991 REM * reset listu, smazani vseho
992 REM * procedure reset;

995 CLS
996 LINE (0, 0)-(639, 479), 15, BF
997 COLOR 0
998 RETURN
999 GOTO 990



1000 REM *********************************************************************
1001 REM * inicializace pera do pocatecni polohy x,y
1002 REM * v rozsahu 0,0..1500,2100
1003 REM * procedure qorg(a,b);

1010 IF a < 0 THEN a = 0
1011 IF a > 1500 THEN a = 1500
1012 IF b < 0 THEN b = 0
1013 IF b > 2100 THEN b = 2100
1020 qpenx = a
1021 qpeny = b
1030 RETURN



1100 REM *********************************************************************
1101 REM * nastaveni rychlosti kresleni 0..5
1102 REM * 5 = maximalni
1103 REM * 1 = minimalni
1104 REM * 0 = mimo limit, zelva
1105 REM * procedure qspeed(a);

1110 IF a < 0 THEN a = 0
1111 IF a > 5 THEN a = 5
1120 qpenspeed = 32767
1130 FOR i = 1 TO a
1131     qpenspeed = INT(qpenspeed / 8)
1132     NEXT i
1140 RETURN



1200 REM *********************************************************************
1201 REM * posun pera na absolutni pozici x,y
1202 REM * v rozsahu 0,0..1500,2100
1203 REM * procedure qmova(a,b);

1210 IF a < 0 THEN a = 0
1211 IF a > 1500 THEN a = 1500
1212 IF b < 0 THEN b = 0
1213 IF b > 2100 THEN b = 2100
1220 qpenx = a
1221 qpeny = b
1230 RETURN



1300 REM *********************************************************************
1301 REM * nakresleni cary z aktualni pozice na absolutni x,y
1302 REM * okraje papiru nejsou hlidane
1303 REM * procedure qvecta(a,b);

1310 LINE (5 + qpeny * 3 / 10, 465 - qpenx * 3 / 10)-(5 + b * 3 / 10, 465 - a * 3 / 10)
1311 qpenx = a
1312 qpeny = b
1320 REM (* zpomalovaci smycka *)
1321 FOR t = qpenspeed TO 0 STEP -1: NEXT t
1330 RETURN



1400 REM *********************************************************************
1401 REM * konfigurace procedury MINI
1402 REM * qJ = pocet opakovani
1403 REM * qN = delitel pro posun
1404 REM * qM = mod kresleni
1405 REM * procedure qconf(a,b,c);

1410 qJ = a: IF a < 1 THEN qJ = 1
1411 qN = b: IF b < 2 THEN qN = 2
1412 qM = c: IF c < 0 THEN qM = 0
1420 RETURN



1450 REM *********************************************************************
1451 REM * otoci body do dalsi pozice
1452 REM * procedure otocit;

1460 X = fnp(X1, X2)
1461 Y = fnp(Y1, Y2)
1462 X2 = fnp(X2, X3)
1463 Y2 = fnp(Y2, Y3)
1464 X3 = fnp(X3, X1)
1465 Y3 = fnp(Y3, Y1)
1466 X1 = X
1467 Y1 = Y
1470 RETURN



1500 REM *********************************************************************
1501 REM * kresleni dvou car ve tvaru L do zmensujici se spiraly
1502 REM * PROCEDURE MINI(a,b,c,d,e,f);
1503 REM *           CONST   J = 50;    (*ROZLISITELNOST KRESBY*)
1504 REM *                   N = 50;    (*DELENI*)

1510 X1 = a: Y1 = b: X2 = c: Y2 = d: X3 = e: Y3 = f
1511 IF qM = 5 THEN GOTO 1640
1512 IF qM = 4 THEN GOTO 1620
1513 IF qM = 3 THEN GOTO 1600
1514 IF qM = 2 THEN GOTO 1580
1515 IF qM = 1 THEN GOTO 1550

1520 REM *********************************************************************
1521 REM * 0 = puvodni kreslici rutina
1522 REM * procedure mode0;

1530 a = X1: b = Y1: GOSUB 1200
1531 FOR i = 1 TO qJ
1532     a = X3: b = Y3: IF (i / 2) <> INT(i / 2) THEN a = X1: b = Y1
1533     GOSUB 1300: REM                (*KRESLENI JEDNIM TAHEM TAM*)
1534     X = fnp(X1, X2)
1535     Y = fnp(Y1, Y2)
1536     X2 = fnp(X2, X3)
1537     Y2 = fnp(Y2, Y3)
1538     a = X2: b = Y2: GOSUB 1300
1539     X3 = fnp(X3, X1)
1540     Y3 = fnp(Y3, Y1)
1541     X1 = X
1542     Y1 = Y
1543     a = X3: b = Y3: IF (i / 2) = INT(i / 2) THEN a = X1: b = Y1
1544     GOSUB 1300: REM                (*KRESLENI JEDNIM TAHEM ZPET*)
1545     NEXT i
1546 RETURN

1550 REM *********************************************************************
1551 REM * 1 = opraveny zacatek kresleni
1552 REM * procedure mode1;

1560 a = X3: b = Y3: GOSUB 1200
1561 a = X2: b = Y2: GOSUB 1300
1562 a = X1: b = Y1: GOSUB 1300
1563 FOR i = 1 TO qJ
1564     a = X3: b = Y3: IF (i / 2) <> INT(i / 2) THEN a = X1: b = Y1
1565     GOSUB 1300
1566     X = fnp(X1, X2)
1567     Y = fnp(Y1, Y2)
1568     X2 = fnp(X2, X3)
1569     Y2 = fnp(Y2, Y3)
1570     a = X2: b = Y2: GOSUB 1300
1571     X3 = fnp(X3, X1)
1572     Y3 = fnp(Y3, Y1)
1573     X1 = X
1574     Y1 = Y
1575     a = X3: b = Y3: IF (i / 2) = INT(i / 2) THEN a = X1: b = Y1
1576     GOSUB 1300
1578     NEXT i
1579 RETURN

1580 REM *********************************************************************
1581 REM * 2 = 2 cary tam a zpet
1582 REM * procedure mode2;

1590 FOR i = 1 TO qJ
1591     a = X3: b = Y3: IF (i / 2) <> INT(i / 2) THEN a = X1: b = Y1
1592     GOSUB 1200
1593     a = X2: b = Y2: GOSUB 1300
1594     a = X3: b = Y3: IF (i / 2) = INT(i / 2) THEN a = X1: b = Y1
1595     GOSUB 1300
1596     GOSUB 1450
1597 NEXT i
1598 RETURN

1600 REM *******************************************************************
1601 REM * 3 = 3 cary tam a zpet
1602 REM * procedure mode3;

1610 a = X1: b = Y1: GOSUB 1200
1611 FOR i = 1 TO qJ
1612     a = X3: b = Y3: IF (i / 2) <> INT(i / 2) THEN a = X1: b = Y1
1613     GOSUB 1300
1614     a = X2: b = Y2: GOSUB 1300
1615     a = X3: b = Y3: IF (i / 2) = INT(i / 2) THEN a = X1: b = Y1
1616     GOSUB 1300
1617     GOSUB 1450
1618 NEXT i
1619 RETURN

1620 REM *********************************************************************
1621 REM * 4 = trojuhelnikova spirala
1622 REM * procedure mode4;

1630 a = X1: b = Y1: GOSUB 1200
1631 FOR i = 1 TO qJ
1632     a = X2: b = Y2: GOSUB 1300
1633     GOSUB 1450
1634     a = X3: b = Y3: GOSUB 1300
1635     a = X1: b = Y1: GOSUB 1300
1636     NEXT i
1637 RETURN

1640 REM *********************************************************************
1641 REM * 5 = uplne trojuhelniky
1642 REM * procedure mode5;

1650 FOR i = 1 TO qJ
1651 a = X1: b = Y1: GOSUB 1200
1652 a = X2: b = Y2: GOSUB 1300
1653 a = X3: b = Y3: GOSUB 1300
1654 a = X1: b = Y1: GOSUB 1300
1655 GOSUB 1450
1656 NEXT i
1657 RETURN



1800 REM *********************************************************************
1801 REM * rotace kytky
1802 REM * kxs,kys = souradnice stredu
1803 REM * kr = polomer
1804 REM * kv = pocet vrcholu
1805 REM * ko = orientace
1806 REM *      0 = nahore hrot
1807 REM *      1 = nahore list
1808 REM * procedure kytka(a,b,c,d,e);

1810 kxs = a: kys = b: kr = c: kv = d: ko = e
1811 IF kv < 2 THEN kv = 2
1812 FOR k = 1 TO kv
1813     u = pipi * (k - 1) / kv
1814     kx1 = kxs + INT(kr * COS(u) + .5)
1815     ky1 = kys + INT(kr * SIN(u) + .5)
1816     u = pipi * (k - .5) / kv
1817     kx2 = kxs + INT(kr * COS(u) + .5)
1818     ky2 = kys + INT(kr * SIN(u) + .5)
1819     u = pipi * k / kv
1820     kx3 = kxs + INT(kr * COS(u) + .5)
1821     ky3 = kys + INT(kr * SIN(u) + .5)

1830     IF (ko / 2) <> INT(ko / 2) THEN GOTO 1840
1831        a = kx1: b = ky1: c = kxs: d = kys: e = kx2: f = ky2: GOSUB 1500
1832        a = kx3: b = ky3: c = kxs: d = kys: e = kx2: f = ky2: GOSUB 1500
1833     GOTO 1850
1840        a = kx2: b = ky2: c = kxs: d = kys: e = kx1: f = ky1: GOSUB 1500
1841        a = kx2: b = ky2: c = kxs: d = kys: e = kx3: f = ky3: GOSUB 1500
1850     NEXT k
1851 RETURN



1900 REM *********************************************************************
1901 REM * rotace vetrniku
1902 REM * vxs,vys = souradnice stredu
1903 REM * vr = polomer
1904 REM * vv = pocet vrcholu
1905 REM * vs = smer
1906 REM *      0 = toci doleva
1907 REM *      1 = toci doprava
1908 REM * procedure vetrnik(a,b,c,d,e);

1910 vxs = a: vys = b: vr = c: vv = d: vs = e
1911 IF vv < 3 THEN vv = 3
1912 FOR v = 1 TO vv
1913     u = pipi * (v - 1) / vv
1914     vx1 = vxs + INT(vr * COS(u) + .5)
1915     vy1 = vys + INT(vr * SIN(u) + .5)
1916     u = pipi * v / vv
1917     vx2 = vxs + INT(vr * COS(u) + .5)
1918     vy2 = vys + INT(vr * SIN(u) + .5)
   
1920     a = vx1: b = vy1: c = vxs: d = vys: e = vx2: f = vy2
1921     IF (s / 2) = INT(s / 2) THEN a = vx2: b = vy2: c = vxs: d = vys: e = vx1: f = vy1
1922     GOSUB 1500
1930     NEXT v
1931 RETURN

_________________
"Dokud nebyly počítače, programování nebylo problémem.
Jestliže bylo několik slabých počítačů, bylo programování malým problémem.
Když však programátoři získali počítače na svou dobu ohromné síly, stalo se také programování ohromným problémem."

E. W. Dijkstra, 1972


Nahoru
 Profil  
 
PříspěvekNapsal: 24.06.2020, 18:42 
Offline
Stydlín

Registrován: 19.06.2020, 21:57
Příspěvky: 9
Bydliště: Jihlava
Has thanked: 0 time
Been thanked: 5 times
Ahoj, podobnou grafiku jsem kdysi dělal na IQ 151 se zapisovačem XY4121. Na githubu jsem našel kód, o který se rád podělím. Není jen můj, algoritmus jsem tenkrát někde opsal, podle komentáře asi v časopisu Elektronika č.6/1988
Kód:
0 REM E6/88-32  MATYAS/VESELY
1 XB=750:YB=1050:REM STRED
2 AX=750:AY=40:REM SOUR. BODU
3 BX =1313:BY=725
5 CX=1313:CY=1375
6 DX=750:DY=1700
7 EX=187:EY=1375
8 FX=187:FY=725
9 D=.05:I=50:REM KROK;POCET
10 SPEED 4
20 ORG0,0
30 XA=AX:YA=AY:XC=BX:YC=BY
40 GOSUB 520
50 XA=CX:YA=CY
60 GOSUB 520
70 XC=DX:YC=DY
80 GOSUB520
90 XA=EX:YA=EY
100 GOSUB 520
110 XC=FX:YC=FY
120 GOSUB 520
130 XA=AX:YA=AY
140 GOSUB 520
145 MOVA0,0
150 END
520 X1=XA:Y1=YA:X2=XB:Y2=YB:X3=XC:Y3=YC
530 FOR J=1 TO I
540 MOVAY1,X1
550 VECTA Y2,X2
560 VECTA Y3,X3
565 REMVECTA Y1,X1:REM TRETI STR
570 X=INT((X2-X1)*D+X1)
580 Y=INT((Y2-Y1)*D+Y1)
590 X2=INT((X3-X2)*D+X2)
600 Y2=INT((Y3-Y2)*D+Y2)
610 X3=INT((X1-X3)*D+X3)
620 Y3=INT((Y1-Y3)*D+Y3)
630 X1=X:Y1=Y
640 NEXT J
650 RETURN


ORG je definice počátku kreslení
MOVA je přesun pera na absolutní souřadnici bez kreslení
VECTA je pohyb na abs. souřadnici s perem dole, tedy kreslení

Jestli najdu trochu času, zkusím to předělat na vykreslování na obrazovce, ať to běží v emulátoru


Nahoru
 Profil  
 
PříspěvekNapsal: 04.07.2020, 08:49 
Offline
Kecka

Registrován: 26.11.2018, 16:59
Příspěvky: 25
Has thanked: 0 time
Been thanked: 2 times
dělá to tohle

Příloha:
xy.PNG
xy.PNG [ 48.89 KiB | Zobrazeno 176 krát ]


Nahoru
 Profil  
 
Zobrazit příspěvky za předchozí:  Seřadit podle  
Odeslat nové téma Odpovědět na téma  [ Příspěvků: 90 ]  Přejít na stránku Předchozí  1, 2, 3, 4, 5, 6

Všechny časy jsou v UTC + 1 hodina [ Letní čas ]


Kdo je online

Uživatelé procházející toto fórum: Žádní registrovaní uživatelé a 2 návštevníků


Nemůžete zakládat nová témata v tomto fóru
Nemůžete odpovídat v tomto fóru
Nemůžete upravovat své příspěvky v tomto fóru
Nemůžete mazat své příspěvky v tomto fóru
Nemůžete přikládat soubory v tomto fóru

Hledat:
Přejít na:  
cron
Založeno na phpBB® Forum Software © phpBB Group
Český překlad – phpBB.cz