Generate PRODIA M45 NC file

generate_nc.hs

import Data.List
import Data.Monoid
import Text.Printf

data Sgn = Posi | Neg deriving Eq
data FP = FP Int Int Sgn | FPInt Int | FPDouble Double

add :: Double -> FP -> FP
add v (FPDouble a) = FPDouble (a + v)

instance Show FP where
	show (FP a b s) = (if s == Posi then "" else "-") ++ show a ++ "." ++ show b
	show (FPInt a) = show a
	show (FPDouble v) = printf "%.2f" v

fromDouble :: Double -> Int -> FP
fromDouble v digit
	| v >= 0 = FP (floor v) (f (v - fromIntegral (floor v))) Posi
	| otherwise = FP (floor v2) (f (v2 - fromIntegral (floor v2))) Neg
	where
		v2 = -v
		f v = floor $ v * (10 ** fromIntegral digit)

fp v = FPDouble v -- fromDouble v 2
int v = FPInt v

data Step = G81 FP FP FP FP FP | G80 | G00 FP FP FP
	| G79 | G90 | G49 | G77 Int | S Int | M03 | X FP | Y FP | Z FP | A FP | B FP
	| M05 | M09 | M30

instance Show Step where
	show (G81 x y z r f) = "G81X"++ show x ++ "Y" ++ show y ++ "Z" ++ show z
			++ "R" ++ show r ++ "F" ++ show f
	show G80 = "G80"
	show (G00 z x y) = "G00Z" ++ show z ++ "\nX" ++ show x ++ "Y" ++ show y
	show G79 = "G79"
	show G90 = "G90"
	show G49 = "G49"
	show (G77 v) = "G77Q" ++ show v
	show (S v) = "S" ++ show v
	show M03 = "M03"
	show (X v) = "X" ++ show v
	show (Y v) = "Y" ++ show v
	show (Z v) = "Z" ++ show v
	show (A v) = "A" ++ show v
	show (B v) = "B" ++ show v
	show M05 = "M05"
	show M09 = "M09"
	show M30 = "M30"

data Steps = Steps [Step]

instance Show Steps where
	show (Steps ss) = intercalate "\n" $ map show ss

instance Monoid Steps where
	mempty = Steps []
	mappend (Steps a) (Steps b) = Steps (a++b)


drill :: Pos -> Steps
drill (Pos x y z) = Steps [G81 x y z (fp 10) (int 200),
		G80, G00 (fp 12) x y]

data Pos = Pos FP FP FP

mkPos :: Double -> Double -> Int -> Int -> Double -> Double -> Double -> [Pos]
mkPos ox oy nx ny pitch depth tilt =
	let
		x xi = ox + pitch * fromIntegral xi
		y yi = oy + pitch * fromIntegral yi
		z yi = -depth - (tan $ tilt * pi / 180) * (y yi)
	in
	[Pos (fp $ x xi) (fp $ y (-yi)) (fp $ z (-yi)) | xi <- [0..(nx-1)], yi <- [0..(ny-1)]]

process :: Double -> [Pos] -> Steps
process deg ps = mconcat [header deg (head ps), mconcat $ map drill ps, footer]

header deg (Pos x y z) = Steps [G79, G90, G49, G77 2000, S 5000, M03, X x, Y y, Z (add 10 z), A (FPDouble deg), B (FPDouble 0)]

footer = Steps [M05, M09, M30]

ex1 = process (-45) $ mkPos 2 0 11 5 0.5 0.6 (-45)
ex2 = process 45 $ mkPos 0 0 11 6 0.5 0.6 45

ex4 = process deg $ mkPos 0 0 11 6 0.5 1 deg
	where
		deg = -45

ex5 = process deg $ mkPos 0 0 11 6 0.5 1 deg
	where
		deg = 45