tttool 1.4.0.5 → 1.5
raw patch · 8 files changed
+161/−60 lines, 8 files
Files
- README.md +2/−1
- src/GMERun.hs +3/−1
- src/KnownCodes.hs +1/−1
- src/Lint.hs +10/−6
- src/OidCode.hs +61/−9
- src/TipToiYaml.hs +37/−5
- src/tttool.hs +46/−36
- tttool.cabal +1/−1
README.md view
@@ -68,7 +68,8 @@ creates a PNG file for each given code scale this to 10cm×10cm By default, it creates a 1200 dpi image. With -d 600, you- obtain a 600 dpi image.+ obtain a 600 dpi image. With -d 600d resp. 1200d you can double the+ size of the pixel. <codes> can be a range, e.g. 1,3,1000-1085. Uses oid-<code>.png as the file name. oid-code [-d DPI] <infile.yaml>
src/GMERun.hs view
@@ -79,7 +79,9 @@ NEq -> (/=) Lt -> (<) GEq -> (>=)- _ -> \_ _ -> False+ Gt -> (>)+ LEq -> (<=)+ Unknowncond _ -> \_ _ -> False value :: Ord r => PlayState r -> TVal r -> Word16 value m (Reg r) = M.findWithDefault 0 r m
src/KnownCodes.hs view
@@ -11,7 +11,7 @@ code2RawCode code = knownRawCodes V.!? fromIntegral code firstObjectCode :: Word16-firstObjectCode = 4716 +firstObjectCode = 1000 lastObjectCode :: Word16 lastObjectCode = fromIntegral $ V.length knownRawCodes - 1
src/Lint.hs view
@@ -29,9 +29,7 @@ unless (null overlapping_segments) $ do printf "Overlapping segments: %d\n" (length overlapping_segments)- forM_ overlapping_segments $ \((o1,l1,d1),(o2,l2,d2)) ->- printf " Offset %08X Size %d (%s) overlaps Offset %08X Size %d (%s) by %d\n"- o1 l1 (ppDesc d1) o2 l2 (ppDesc d2) (o1 + l1 - o2)+ mapM_ (uncurry report) overlapping_segments where hyp1 :: Line ResReg -> Bool hyp1 (Line _ _ as mi) = all ok as@@ -43,6 +41,12 @@ hyp2 :: Word16 -> Line ResReg -> Bool hyp2 n (Line _ _ _ mi) = all (<= n) mi ---+ report :: Segment -> Segment -> IO ()+ report (o1,l1,d1) (o2,l2,d2)+ | l1 == l2 && o1 == o2+ = printf " Offset %08X Size %d referenced by %s and %s\n"+ o1 l1 (ppDesc d1) (ppDesc d2)+ | otherwise+ = printf " Offset %08X Size %d (%s) overlaps Offset %08X Size %d (%s) by %d\n"+ o1 l1 (ppDesc d1) o2 l2 (ppDesc d2) overlap+ where overlap = o1 + l1 - o2
src/OidCode.hs view
@@ -1,6 +1,6 @@-{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE BangPatterns, TupleSections #-} -module OidCode (genRawPNG, DPI(..)) where+module OidCode (genRawPNG, DPI(..), PixelSize(..)) where import Data.Word import Data.Bits@@ -86,9 +86,10 @@ -} data DPI = D1200 | D600+data PixelSize = SinglePixel | DoublePixel imageFromBlackPixels :: Int -> Int -> [(Int, Int)] -> Image PixelYA8-imageFromBlackPixels width height pixels = runST $ do +imageFromBlackPixels width height pixels = runST $ do i <- createMutableImage width height background forM_ pixels $ \(x,y) -> do writePixel i x y black@@ -97,8 +98,8 @@ black = PixelYA8 minBound maxBound background = PixelYA8 maxBound minBound -oidImage :: DPI -> Word16 -> Image PixelYA8-oidImage dpi code =+oidImage :: DPI -> PixelSize -> Word16 -> Image PixelYA8+oidImage dpi ps code = imageFromBlackPixels (width *4*dotsPerPoint) (height*4*dotsPerPoint)@@ -119,9 +120,52 @@ [ (p, plain) | p <- [(0,0), (1,0), (2,0), (3,0), (0,1), (0,3) ] ] ++ [ ((0,2), special) ] - plain | D1200 <- dpi = [ (5,5), (5,6), (6,5), (6,6) ]- | D600 <- dpi = [ (3,3) ]+ plain | D1200 <- dpi, SinglePixel <- ps = coordsOfDots+ [ " "+ , " "+ , " "+ , " "+ , " "+ , " ** "+ , " ** "+ , " "+ , " "+ , " "+ , " "+ , " "+ ]+ | D1200 <- dpi, DoublePixel <- ps = coordsOfDots+ [ " "+ , " "+ , " "+ , " "+ , " **** "+ , " **** "+ , " **** "+ , " **** "+ , " "+ , " "+ , " "+ , " "+ ]+ | D600 <- dpi, SinglePixel <- ps = coordsOfDots+ [ " "+ , " "+ , " * "+ , " "+ , " "+ , " "+ ]+ | D600 <- dpi, DoublePixel <- ps = coordsOfDots+ [ " "+ , " "+ , " ** "+ , " ** "+ , " "+ , " "+ ] + s | D1200 <- dpi = 2 | D600 <- dpi = 1 ss | D1200 <- dpi = 3@@ -134,6 +178,14 @@ position ((n,m), p) = at (n*dotsPerPoint, m*dotsPerPoint) p + coordsOfDots :: [String] -> [(Int, Int)]+ coordsOfDots rows =+ [ (x,y)+ | (row, y) <- zip rows [0..]+ , (c, x) <- zip row [0..]+ , c == '*'+ ]+ -- Drawing combinators at (x, y) = map (\(x', y') -> (x + x', y + y'))@@ -142,6 +194,6 @@ -genRawPNG :: DPI -> Word16 -> FilePath -> IO ()-genRawPNG dpi code filename = writePng filename (oidImage dpi code)+genRawPNG :: DPI -> PixelSize -> Word16 -> FilePath -> IO ()+genRawPNG dpi ps code filename = writePng filename (oidImage dpi ps code)
src/TipToiYaml.hs view
@@ -150,9 +150,15 @@ printf "The .yaml file specifies code %d for script \"%s\",\ \but the .codes.yamls file specifies %d. Please fix this!" c2 s c1 -scriptCodes :: [String] -> CodeMap -> Either String (String -> Word16, CodeMap)-scriptCodes [] codeMap = Right (error "scriptCodes []", codeMap)-scriptCodes codes codeMap+toWord16 :: Word32 -> Word16+toWord16 x = fromIntegral x++toWord32 :: Word16 -> Word32+toWord32 x = fromIntegral x++scriptCodes :: [String] -> CodeMap -> Word32 -> Either String (String -> Word16, CodeMap)+scriptCodes [] codeMap productId = Right (error "scriptCodes []", codeMap)+scriptCodes codes codeMap productId | null strs || null nums = Right (lookupCode, totalMap) | otherwise = Left "Cannot mix numbers and names in scripts." where@@ -164,11 +170,37 @@ Nothing -> Left s Just n -> Right (n::Word16) +-- The following logic (for objectCodes) tries to use different object codes +-- for different projects, as far as possible. This makes the detection of not +-- having activated a book/product more robust.++-- We could theoretically set: +-- objectCodeOffsetMax = lastObjectCode - firstObjectCode.+-- This would assign perfectly usable object codes, and would minimize the +-- probability of object code collisions between products, but sometimes +-- object codes would wrap around from 16383 to 1000 even for small projects +-- which may be undesirable. We arbitrarily do not use the last 999 possible+-- offsets to avoid a wrap around in object codes for projects with <= 1000+-- object codes. This does not impose any limit on the number of object codes +-- per project. Every project can always use all 15384 object codes.+ objectCodeOffsetMax = lastObjectCode - firstObjectCode - 999++-- Distribute the used object codes for different projects across the whole +-- range of usable object codes. We do this by multiplying the productId with +-- the golden ratio to achive a maximum distance between different projects, +-- indepedent of the total number of different projects.+-- 8890 = (16383-1000-999+1)*((sqrt(5)-1)/2)+ objectCodeOffset = toWord16(rem (productId * 8890) (toWord32(objectCodeOffsetMax) + 1))++-- objectCodes always contains _all_ possible object codes [firstObjectCode..lastObjectCode], +-- starting at firstObjectCode+objectCodeOffset and then wrapping around.+ objectCodes = [firstObjectCode + objectCodeOffset .. lastObjectCode] ++ [firstObjectCode .. firstObjectCode + objectCodeOffset - 1]+ newAssignments = M.fromList $ zip newStrs $ filter (`S.notMember` usedCodes) $- [firstObjectCode .. lastObjectCode]+ objectCodes totalMap = M.fromList [ (str, fromJust $@@ -219,7 +251,7 @@ extCodeMap (fromMaybe M.empty ttyScriptCodes) - (scriptMap, totalMap) <- either fail return $ scriptCodes (M.keys ttyScripts) codeMap+ (scriptMap, totalMap) <- either fail return $ scriptCodes (M.keys ttyScripts) codeMap ttyProduct_Id let m = M.mapKeys scriptMap ttyScripts first = fst (M.findMin m)
src/tttool.hs view
@@ -156,8 +156,8 @@ printSegment (o,l,["-- unknown --"]) printExtract bytes o l putStrLn ""- Right s@(o,l,_) -> do- printSegment s+ Right ss@((o,l,_):_) -> do+ mapM_ printSegment ss printExtract bytes o l putStrLn "" @@ -202,15 +202,16 @@ pos = fromIntegral pos' -addHoles :: [Segment] -> [Either (Offset, Word32) Segment]-addHoles = go- where go [] = []- go [s] = [Right s]- go (s@(o1,l1,d2):r@((o2,_,_):_))- | o1 + l1 == o2 -- no hole- = Right s : go r- | otherwise -- a hole- = Right s : Left (o1+l1, o2 - (o1 + l1)) : go r+-- returns a list of segments in case of overlap+addHoles :: [Segment] -> [Either (Offset, Word32) [Segment]]+addHoles = go 0+ where go at [] = []+ go at ss@((o,l,d):_)+ | at /= o -- a hole+ = Left (at, o-at) : go o ss+ | otherwise -- no hole+ = let (this, others) = span (\(o',l',_) -> o == o' && l == l') ss+ in Right this : go (o + l) others unknown_segments :: FilePath -> IO () unknown_segments file = do@@ -272,42 +273,42 @@ writeTipToi out tt -genPNGs :: DPI -> String -> IO ()-genPNGs dpi arg = do+genPNGs :: DPI -> PixelSize -> String -> IO ()+genPNGs dpi ps arg = do ex <- doesFileExist arg- if ex then genPNGsForFile dpi arg- else genPNGsForCodes dpi arg+ if ex then genPNGsForFile dpi ps arg+ else genPNGsForCodes dpi ps arg -genPNGsForFile :: DPI -> FilePath -> IO ()-genPNGsForFile dpi inf = do+genPNGsForFile :: DPI -> PixelSize -> FilePath -> IO ()+genPNGsForFile dpi ps inf = do (tty, codeMap) <- readTipToiYaml inf (tt, totalMap) <- ttYaml2tt (takeDirectory inf) tty codeMap let codes = ("START", fromIntegral (ttProductId tt)) : M.toList totalMap forM_ codes $ \(s,c) -> do- genPNG dpi c $ printf "oid-%d-%s.png" (ttProductId tt) s+ genPNG dpi ps c $ printf "oid-%d-%s.png" (ttProductId tt) s -genPNGsForCodes :: DPI -> String -> IO ()-genPNGsForCodes dpi code_str = do+genPNGsForCodes :: DPI -> PixelSize -> String -> IO ()+genPNGsForCodes dpi ps code_str = do codes <- parseRange code_str forM_ codes $ \c -> do- genPNG dpi c $ printf "oid-%d.png" c+ genPNG dpi ps c $ printf "oid-%d.png" c -genPNG :: DPI -> Word16 -> String -> IO ()-genPNG dpi c filename =+genPNG :: DPI -> PixelSize -> Word16 -> String -> IO ()+genPNG dpi ps c filename = case code2RawCode c of Nothing -> printf "Skipping %s, code %d not known.\n" filename c Just r -> do printf "Writing %s.. (Code %d, raw code %d)\n" filename c r- genRawPNG dpi r filename+ genRawPNG dpi ps r filename -genPNGsForRawCodes :: DPI -> String -> IO ()-genPNGsForRawCodes dpi code_str = do+genPNGsForRawCodes :: DPI -> PixelSize -> String -> IO ()+genPNGsForRawCodes dpi ps code_str = do codes <- parseRange code_str forM_ codes $ \r -> do let filename = printf "oid-raw-%d.png" r printf "Writing %s... (raw code %d)\n" filename r- genRawPNG dpi r filename+ genRawPNG dpi ps r filename -- The main function@@ -361,21 +362,29 @@ main' t ("export": inf : out: [] ) = export inf out main' t ("assemble": inf : out: []) = assemble inf out main' t ("oid-code": "-d" : "600" : codes@(_:_))- = genPNGs D600 (unwords codes)+ = genPNGs D600 SinglePixel (unwords codes) main' t ("oid-code": "-d" : "1200" : codes@(_:_))- = genPNGs D1200 (unwords codes)+ = genPNGs D1200 SinglePixel (unwords codes)+main' t ("oid-code": "-d" : "600d" : codes@(_:_))+ = genPNGs D600 DoublePixel (unwords codes)+main' t ("oid-code": "-d" : "1200d" : codes@(_:_))+ = genPNGs D1200 DoublePixel (unwords codes) main' t ("oid-code": "-d" : _) = do- putStrLn $ "The parameter to -d has to be 600 or 1200"+ putStrLn $ "The parameter to -d has to be 600, 1200, 600d or 1200d" exitFailure-main' t ("oid-code": codes@(_:_)) = genPNGs D1200 (unwords codes)+main' t ("oid-code": codes@(_:_)) = genPNGs D1200 SinglePixel (unwords codes) main' t ("raw-oid-code": "-d" : "600" : codes@(_:_))- = genPNGsForRawCodes D600 (unwords codes)+ = genPNGsForRawCodes D600 SinglePixel (unwords codes) main' t ("raw-oid-code": "-d" : "1200" : codes@(_:_))- = genPNGsForRawCodes D1200 (unwords codes)+ = genPNGsForRawCodes D1200 SinglePixel (unwords codes)+main' t ("raw-oid-code": "-d" : "600d" : codes@(_:_))+ = genPNGsForRawCodes D600 DoublePixel (unwords codes)+main' t ("raw-oid-code": "-d" : "1200d" : codes@(_:_))+ = genPNGsForRawCodes D1200 DoublePixel (unwords codes) main' t ("raw-oid-code": "-d" : _) = do- putStrLn $ "The parameter to -d has to be 600 or 1200"+ putStrLn $ "The parameter to -d has to be 600, 1200, 600d or 1200d" exitFailure-main' t ("raw-oid-code": codes@(_:_)) = genPNGsForRawCodes D1200 (unwords codes)+main' t ("raw-oid-code": codes@(_:_)) = genPNGsForRawCodes D1200 SinglePixel (unwords codes) main' _ _ = do prg <- getProgName putStrLn $ "This is the Tiptoi toolkit, version " ++ showVersion version@@ -425,7 +434,8 @@ putStrLn $ " creates a PNG file for each given code" putStrLn $ " scale this to 10cm×10cm" putStrLn $ " By default, it creates a 1200 dpi image. With -d 600, you"- putStrLn $ " obtain a 600 dpi image."+ putStrLn $ " obtain a 600 dpi image. With -d 600d resp. 1200d you can"+ putStrLn $ " double the size of the pixel." putStrLn $ " <codes> can be a range, e.g. 1,3,1000-1085." putStrLn $ " Uses oid-<code>.png as the file name." putStrLn $ " oid-code [-d DPI] <infile.yaml>"
tttool.cabal view
@@ -1,5 +1,5 @@ name: tttool-version: 1.4.0.5+version: 1.5 synopsis: Working with files for the Tiptoi® pen description: The Ravensburger Tiptoi® pen is programmed via special files. Their file format has been reverse engineered; this