OldComp.cz

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


Právě je 28.03.2024, 10:05

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




Odeslat nové téma Odpovědět na téma  [ Příspěvků: 100 ]  Přejít na stránku Předchozí  1 ... 3, 4, 5, 6, 7  Další
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: 2773
Has thanked: 224 times
Been thanked: 601 times
Kytky můžou být orientované svisle nebo vodorovně:
Příloha:
kytky.png
kytky.png [ 7.61 KiB | Zobrazeno 10206 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.

_________________
Plesnivý sýr z Tesca, zatuchlé kuřecí řízky z Albertu, oslizlé hovězí a myší trus z Lidlu.
Nákup potravinářské inspekce v ČR, říjen 2023.


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: 2773
Has thanked: 224 times
Been thanked: 601 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

_________________
Plesnivý sýr z Tesca, zatuchlé kuřecí řízky z Albertu, oslizlé hovězí a myší trus z Lidlu.
Nákup potravinářské inspekce v ČR, říjen 2023.


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: 1554
Has thanked: 485 times
Been thanked: 634 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

_________________
より良い競争相手からソフトウェアを購入する (。◕‿‿◕。)
Ďábel se skrývá v detailu (staré technické rčení)


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: 2773
Has thanked: 224 times
Been thanked: 601 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 10193 krát ]

_________________
Plesnivý sýr z Tesca, zatuchlé kuřecí řízky z Albertu, oslizlé hovězí a myší trus z Lidlu.
Nákup potravinářské inspekce v ČR, říjen 2023.


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

Registrován: 24.05.2018, 22:32
Příspěvky: 1972
Bydliště: Most, Praha
Has thanked: 863 times
Been thanked: 697 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: 2773
Has thanked: 224 times
Been thanked: 601 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!

_________________
Plesnivý sýr z Tesca, zatuchlé kuřecí řízky z Albertu, oslizlé hovězí a myší trus z Lidlu.
Nákup potravinářské inspekce v ČR, říjen 2023.


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

Registrován: 10.07.2014, 01:57
Příspěvky: 168
Has thanked: 25 times
Been thanked: 225 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]
491 krát
Nahoru
 Profil  
 
PříspěvekNapsal: 18.05.2020, 14:12 
Offline
Radil

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


Přílohy:
carovka.jpg
carovka.jpg [ 22.82 KiB | Zobrazeno 10112 krát ]
carovka.pdf [241.09 KiB]
515 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: 2773
Has thanked: 224 times
Been thanked: 601 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 10074 krát ]

Příloha:
rotace.png
rotace.png [ 25.45 KiB | Zobrazeno 10074 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.

_________________
Plesnivý sýr z Tesca, zatuchlé kuřecí řízky z Albertu, oslizlé hovězí a myší trus z Lidlu.
Nákup potravinářské inspekce v ČR, říjen 2023.


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: 1554
Has thanked: 485 times
Been thanked: 634 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ší...

_________________
より良い競争相手からソフトウェアを購入する (。◕‿‿◕。)
Ďábel se skrývá v detailu (staré technické rčení)


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

Registrován: 24.05.2018, 22:32
Příspěvky: 1972
Bydliště: Most, Praha
Has thanked: 863 times
Been thanked: 697 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: 2773
Has thanked: 224 times
Been thanked: 601 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 9966 krát ]

_________________
Plesnivý sýr z Tesca, zatuchlé kuřecí řízky z Albertu, oslizlé hovězí a myší trus z Lidlu.
Nákup potravinářské inspekce v ČR, říjen 2023.


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: 2773
Has thanked: 224 times
Been thanked: 601 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 9897 krát ]

Příloha:
QBrotace.png
QBrotace.png [ 29.5 KiB | Zobrazeno 9897 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

_________________
Plesnivý sýr z Tesca, zatuchlé kuřecí řízky z Albertu, oslizlé hovězí a myší trus z Lidlu.
Nákup potravinářské inspekce v ČR, říjen 2023.


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: 1 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
Profík

Registrován: 26.11.2018, 16:59
Příspěvky: 580
Bydliště: Holešov
Has thanked: 13 times
Been thanked: 90 times
dělá to tohle

Příloha:
xy.PNG
xy.PNG [ 48.89 KiB | Zobrazeno 9335 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ů: 100 ]  Přejít na stránku Předchozí  1 ... 3, 4, 5, 6, 7  Další

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 3 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:  
Založeno na phpBB® Forum Software © phpBB Group
Český překlad – phpBB.cz