diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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. can be a range, e.g. 1,3,1000-1085. Uses oid-.png as the file name. oid-code [-d DPI] diff --git a/src/GMERun.hs b/src/GMERun.hs --- a/src/GMERun.hs +++ b/src/GMERun.hs @@ -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 diff --git a/src/KnownCodes.hs b/src/KnownCodes.hs --- a/src/KnownCodes.hs +++ b/src/KnownCodes.hs @@ -11,7 +11,7 @@ code2RawCode code = knownRawCodes V.!? fromIntegral code firstObjectCode :: Word16 -firstObjectCode = 4716 +firstObjectCode = 1000 lastObjectCode :: Word16 lastObjectCode = fromIntegral $ V.length knownRawCodes - 1 diff --git a/src/Lint.hs b/src/Lint.hs --- a/src/Lint.hs +++ b/src/Lint.hs @@ -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 diff --git a/src/OidCode.hs b/src/OidCode.hs --- a/src/OidCode.hs +++ b/src/OidCode.hs @@ -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) diff --git a/src/TipToiYaml.hs b/src/TipToiYaml.hs --- a/src/TipToiYaml.hs +++ b/src/TipToiYaml.hs @@ -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) diff --git a/src/tttool.hs b/src/tttool.hs --- a/src/tttool.hs +++ b/src/tttool.hs @@ -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 $ " can be a range, e.g. 1,3,1000-1085." putStrLn $ " Uses oid-.png as the file name." putStrLn $ " oid-code [-d DPI] " diff --git a/tttool.cabal b/tttool.cabal --- a/tttool.cabal +++ b/tttool.cabal @@ -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