Task: Simple turtle graphics








VB: 




Declare Sub LEF (gradi As Integer)
Declare Sub SETCOL (C As Integer)
Declare Sub SETSIZE (C As Integer)
Declare Sub RIGH (gradi As Integer)
Declare Sub FORW (passi As Integer)
Declare Sub BACK (passi As Integer)
Declare Sub TURTLE (numero As Integer)
Declare Sub UP ()
Declare Sub DOWN ()
Declare Sub DTurtle ()

Dim Shared As Integer graph, dimen, angulo, N, dis, su, pasos
Dim Shared As Integer colore(10), figura(5000,10), figura2()
Dim Shared As Long X(10), Y(10)
Dim Shared As String comando

Sub BACK (passi As Integer)
    pasos = passi
    comando = "d " & Str(passi)
    DTurtle
    comando = ""
    pasos = 0
End Sub

Sub DOWN
    su = 0
End Sub

Sub DTurtle Static
    Dim As Integer rifa, lavora, XX, YY, scher(), FX, FY
    Dim As String R
    
    If rifa = 0 Then rifa = 1: Redim scher(5000)
    If lavora Then Put (XX - dimen * 4, YY - dimen * 2), scher, Pset
    
    If su Then comando = "b" & comando
    FX = X(N)
    FY = Y(N)
    R = "s" & Str(dimen) & "bm" & Str(FX) & "," & Str(FY) & "c" & Str(colore(N)) & "Ta" & Str(angulo) & comando
    Draw R
    X(N) = X(N) + Sin(angulo / 57.2957) * dimen / 4 * pasos
    Y(N) = Y(N) + Cos(angulo / 57.2957) * dimen / 4 * pasos
    XX = X(N)
    YY = Y(N)
    Get (X(N) - dimen * 4, Y(N) - dimen * 2)-(X(N) + dimen * 4, Y(N) + dimen * 2), scher: lavora = 1
    If dis = 0 Then
        R = "bm" & Str(XX) & "," & Str(YY) & "Ta" & Str(angulo) & "r1 ta " & Str(angulo + 15 + 360 * (angulo + 15 > 360)) & "u7 ta " & Str(angulo + 165 + 360 * (angulo + 165 > 360)) & "u7 ta" & Str(angulo) & " m" & Str(XX) & "," & Str(YY)
        Draw R
    Else
        Put (XX, YY), figura2, Or
    End If
End Sub

Sub FORW (passi As Integer)
    pasos = -passi
    comando = "u " & Str(passi)
    DTurtle
    comando = ""
    pasos = 0
End Sub

Sub LEF (gradi As Integer)
    angulo += gradi
    Do Until angulo <= 360
        angulo -= 360
    Loop
    DTurtle
End Sub

Sub RIGH (gradi As Integer)
    angulo -= gradi
    Do Until angulo >= 0
        angulo += 360
    Loop
    DTurtle
End Sub

Sub SETCOL (C As Integer)
    colore(N) = C
    DTurtle
End Sub

Sub SETSIZE (C As Integer)
    dimen = C
    DTurtle
End Sub

Sub TURTLE (numero As Integer) Static
    Dim As Integer i, NN, j
    Dim As Integer ang()
    
    Redim figura2(dis)
    If dis <> 0 And graph <> 0 Then
        For i = 0 To dis
            figura2(i) = figura(i, numero)
        Next i
    End If
    NN = N
    N = numero
    If j = 0 Then j = 1: Redim ang(10): dimen = 4
    If X(numero) = 0 Then X(numero) = 320
    If Y(numero) = 0 Then Y(numero) = 100: colore(numero) = 15
    ang(NN) = angulo
    angulo = ang(N)
    DTurtle
End Sub

Sub UP
    su = 1
End Sub




Ada: with Ada.Text_IO; use Ada.Text_IO;
with Ada.Characters; use Ada.Characters;
with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
with Ada.Strings; use Ada.Strings;


procedure main is
    type Sketch_Pad is array(1 .. 50, 1 .. 50) of Character;
    thePen : Boolean := True; 
    sketch : Sketch_Pad;
    ycorr, xcorr : Integer := 25;

    
    function penPosition(thePen : in out Boolean) return String;
    procedure initGrid(sketch : in out Sketch_Pad);
    procedure commandMenu(thePen : in out Boolean; xcorr : in out Integer;
                          ycorr : in out Integer);
    procedure showMenu(xcorr : in out Integer; ycorr : in out Integer;
                       thePen : in out Boolean; sketch : in Sketch_Pad);
    procedure moveCursor(thePen : in Boolean; sketch : in out Sketch_Pad;
                         xcorr : in out Integer; ycorr : in out Integer;
                         ch : in Integer);
    procedure showGrid(sketch : in Sketch_Pad);

    
    procedure initGrid(sketch : in out Sketch_Pad) is
    begin
        sketch := (others => (others => ' '));
    end initGrid;

    
    procedure showMenu(xcorr : in out Integer; ycorr : in out Integer;
                       thePen : in out Boolean; sketch : in Sketch_Pad) is

        choice : Integer := 0;
    begin
        while choice /= 4 loop
            Set_Col(15);
            Put("TURTLE GRAPHICS APPLICATION");
            Set_Col(15);
            Put("===========================");
            New_Line(2);

            Put_Line("Enter 1 to print the grid map");
            Put_Line("Enter 2 for command menu");
            Put_Line("Enter 3 to raise pen up / down");
            Put_Line("Enter 4 to exit the application");
            choice := integer'value(Get_Line);

            exit when choice = 4;

            case choice is
                when 1 => showGrid(sketch);
                when 2 => commandMenu(thePen, xcorr, ycorr);
                when 3 => Put_Line("Pen is "
                              & penPosition(thePen));
                when others => Put_Line("Invalid input");
            end case;
        end loop;
    end showMenu;

    
    
    function penPosition(thePen : in out Boolean) return String is
        str1 : constant String := "raised UP";
        str2 : constant String := "raised DOWN";
    begin
        if thePen = True then
            thePen := False;
            return str2;
        else
            thePen := True;
        end if;

        return str1;
    end penPosition;

    
    
    procedure commandMenu(thePen : in out Boolean; xcorr : in out Integer;
                          ycorr : in  out Integer) is

        choice : Integer := 0;
    begin
        while choice <= 0 or choice > 5 loop
            Set_Col(15);
            Put("Command Menu");
            Set_Col(15);
            Put("============");
            New_Line(2);

            Put_Line("To move North enter 1");
            Put_Line("To move South enter 2");
            Put_Line("To move East enter 3");
            Put_Line("To move West enter 4");
            Put_Line("To return to previous menu enter 5");
            choice := integer'value(Get_Line);

            case choice is
                when 1 => moveCursor(thePen, sketch, xcorr, ycorr, choice);
                when 2 => moveCursor(thePen, sketch, xcorr, ycorr, choice);
                when 3 => moveCursor(thePen, sketch, xcorr, ycorr, choice);
                when 4 => moveCursor(thePen, sketch, xcorr, ycorr, choice);
                when 5 => showMenu(xcorr, ycorr, thePen, sketch);
                when others => Put_Line("Invalid choice");
            end case;
        end loop;
    end commandMenu;


    
    
    
    
    procedure moveCursor(thePen : in Boolean; sketch : in out Sketch_Pad;
                         xcorr : in out Integer; ycorr : in out Integer;
                         ch : in Integer) is

    begin
        if thePen = True then 
            case ch is
                when 1 => xcorr := xcorr - 1; ycorr := ycorr;
                    sketch(xcorr, ycorr) := ' ';
                when 2 => xcorr := xcorr + 1; ycorr := ycorr;
                    sketch(xcorr, ycorr) := ' ';
                when 3 => xcorr := xcorr; ycorr := ycorr + 1;
                    sketch(xcorr, ycorr) := ' ';
                when 4 => xcorr := xcorr; ycorr := ycorr - 1;
                    sketch(xcorr, ycorr) := ' ';
                when others => Put("Unreachable Code");
            end case;

        else 
            case ch is
                when 1 => xcorr := xcorr - 1; ycorr := ycorr;
                    sketch(xcorr, ycorr) := '#';
                when 2 => xcorr := xcorr + 1; ycorr := ycorr;
                    sketch(xcorr, ycorr) := '#';
                when 3 => xcorr := xcorr; ycorr := ycorr + 1;
                    sketch(xcorr, ycorr) := '#';
                when 4 => xcorr := xcorr; ycorr := ycorr - 1;
                    sketch(xcorr, ycorr) := '#';
                when others => Put("Unreachable Code");
            end case;
        end if;
    end moveCursor;

    
    procedure showGrid(sketch : in Sketch_Pad) is
    begin
        New_Line;

        for I in sketch'Range(1) loop
            for J in sketch'Range(2) loop
                Put(character'image(sketch(I,J)));
            end loop;
            New_Line;
        end loop;
        New_Line;
    end showGrid;

begin
    New_Line;

    initGrid(sketch);
    showMenu(xcorr, ycorr, thePen, sketch);

   New_Line;
end main;