gcode.pas

Uses Classes, SysUtils, StrUtils;

Type
    TCode = Record
        fCmd,
        fParam : String;
    End;

    TCoord = Record
        X, Y, Z : Real;
    End;
    TCoordArray = Array Of TCoord;

Const
    ccNullCode : TCode = (fCmd : ''; fParam : '');

Var
    gInputFile,
    gOutputFile : TStringList;
    gCoords : TCoordArray;
    gLastX,
    gLastY,
    gLastZ: Real;
    gScaleFactor : Real;
    gCurrentZ : Integer;

Function IsAlpha(Const aChar : Char): Boolean;
Begin
    Result := aChar In ['a'..'z', 'A'..'Z'];
End;

Function IsNumber(Const aChar : Char): Boolean;
Begin
    Result := aChar In ['0'..'9', '.', '-'];
End;

Function GetAlpha(Var aString: String): String;
Var
    lDigit : Char;
Begin
    Result := '';
    If aString <> '' Then
    Begin
        lDigit := aString[1];
        If IsAlpha(lDigit) Then
        Begin
            Delete(aString, 1, 1);
            Result := '' + lDigit;
        End;
    End;
End;

Function GetNumber(Var aString: String): String;
Var
    lDigit : Char;
Begin
    Result := '';
    If aString <> '' Then
    Begin
        lDigit := aString[1];
        If IsNumber(lDigit) Then
            While (IsNumber(lDigit)) And (aString <> '') Do
            Begin
                Delete(aString, 1, 1);
                Result := Result + lDigit;
                If aString <> '' Then
                    lDigit := aString[1];
            End;
    End;
End;

Function GetNextParam(Var aString : String): TCode;
Begin
    Result := ccNullCode;
    If aString <> '' Then
        If IsAlpha(aString[1]) Then
        Begin
            Result.fCmd := GetAlpha(aString);
            Result.fParam := GetNumber(aString);
        End;
End;

Function ParseParamsXYZ(Var aString : String): TCoord;
Var
    lCode : TCode;
    lHasX, lHasY, lHasZ : Boolean;
Begin
    lHasX := False;
    lHasY := False;
    lHasZ := False;
    While (aString <> '') Do
    Begin
        lCode := GetNextParam(aString);
        If lCode.fCmd = 'X' Then
        Begin
            lHasX := True;
            Result.X := StrToFloat(lCode.fParam);
        End;
        If lCode.fCmd = 'Y' Then
        Begin
            lHasY := True;
            Result.Y := StrToFloat(lCode.fParam);
        End;
        If lCode.fCmd = 'Z' Then
        Begin
            lHasZ := True;
            Result.Z := StrToFloat(lCode.fParam);
        End;
    End;
    If Not lHasX Then
        Result.X := gLastX;
    If Not lHasY Then
        Result.Y := gLastY;
    If Not lHasZ Then
        Result.Z := gLastZ;
End;

Procedure AddXY(Const aX, aY : Integer);
Begin
    SetLength(gCoords, Length(gCoords) + 1);
    gCoords[High(gCoords)].X := aX;
    gCoords[High(gCoords)].Y := aY;
    gCoords[High(gCoords)].Z := gCurrentZ;
End;

Procedure DrawLine2d(Const aX1, aY1, aX2, aY2 : Integer);
Var
    yUnit,
    xUnit,
    yDiff,
    xDiff,
    yPos,
    xPos,
    ErrorTerm,
    Leng,
    i : Integer;
Begin
    yPos := aX1;
    xPos := aY1;
    yDiff := aY2 - aY1;
    If yDiff < 0 Then
    Begin
        yDiff := yDiff * -1;
        yUnit := -1;
    End
    Else
        yUnit := 1;
    xDiff := aX2 - aX1;
    If xDiff < 0 Then
    Begin
        xDiff := xDiff * -1;
        xUnit := -1;
    End
    Else
        xUnit := 1;
    ErrorTerm := 0;
    If xDiff > yDiff Then
    Begin
        Leng := xDiff + 1;
        i := 0;
        While i < Leng Do
        Begin
            AddXY(xPos, yPos);
            xPos := xPos + xUnit;
            ErrorTerm := ErrorTerm + yDiff;
            If ErrorTerm > xDiff Then
            Begin
                ErrorTerm := ErrorTerm - xDiff;
                yPos := yPos + yUnit;
            End;
            Inc(i);
        End;
    End
    Else
    Begin
        Leng := yDiff + 1;
        i := 0;
        While i < Leng Do
        Begin
            AddXY(xPos, yPos);
            yPos := yPos + yUnit;
            ErrorTerm := ErrorTerm + xDiff;
            If ErrorTerm > xDiff Then
            Begin
                ErrorTerm := ErrorTerm - yDiff;
                xPos := xPos + xUnit;
            End;
            Inc(i);
        End;
    End;
End;

Procedure DrawLine3d(Const aX1, aY1, aZ1, aX2, aY2, aZ2 : Real);
Var
    lRX1,
    lRY1,
    lRZ1,
    lRX2,
    lRY2,
    lRZ2 : Integer;
Begin
    lRX1 := Round(aX1);
    lRY1 := Round(aY1);
    lRZ1 := Round(aZ1);
    lRX2 := Round(aX2);
    lRY2 := Round(aY2);
    lRZ2 := Round(aZ2);
    If lRZ1 = lRZ2 Then
        If Not((lRX1 = lRX2) And (lRY1 = lRY2)) Then
            DrawLine2d(lRX1, lRY1, lRX2, lRY2)
        Else
    Else
        Inc(gCurrentZ);
End;

Procedure Startup;
Begin
    gInputFile := TStringList.Create;
    gOutputFile := TStringList.Create;
    gInputFile.LoadFromFile(ParamStr(1));
    gScaleFactor := StrToFloat(ParamStr(3));
End;

Procedure CloseUp;
Begin
    gOutputFile.SaveToFile(ParamStr(2));
    FreeAndNil(gInputFile);
    FreeAndNil(gOutputFile);
End;

Var
    lTmp : String;
    lCtrl : Integer;
    lCode : TCode;
    lCoords : TCoord;

Begin
    Startup;
    gLastX := 0;
    gLastY := 0;
    gLastZ := 0;
    gCurrentZ := 0;
    For lCtrl := 0 To gInputFile.Count - 1 Do
    Begin
        lTmp := gInputFile[lCtrl];
        lTmp := DelChars(lTmp, ' ');
        lTmp := Copy2SymbDel(lTmp, ';');
        If lTmp <> '' Then
        Begin
            lCode := GetNextParam(lTmp);
            If (lCode.fCmd = 'G') And (lCode.fParam = '1') Then
            Begin
                lCoords := ParseParamsXYZ(lTmp);
                DrawLine3D(
                    gLastX * gScaleFactor,
                    gLastY * gScaleFactor,
                    gLastZ * gScaleFactor,
                    lCoords.X * gScaleFactor,
                    lCoords.Y * gScaleFactor,
                    lCoords.Z * gScaleFactor
                );
                gLastX := lCoords.X;
                gLastY := lCoords.Y;
                gLastZ := lCoords.Z;
            End;
        End;
    End;
    For lCtrl := 0 To Length(gCoords) - 1 Do
    Begin
        gOutputFile.Add(
            IntToStr(Round(gCoords[lCtrl].X)) + ',' +
            IntToStr(Round(gCoords[lCtrl].Y)) + ',' +
            IntToStr(Round(gCoords[lCtrl].Z))
        );
    End;
    CloseUp;
End.