--- a/hedgewars/PNGh.pas Thu Apr 19 18:15:03 2012 +0200
+++ b/hedgewars/PNGh.pas Thu Apr 19 23:36:20 2012 +0400
@@ -41,10 +41,10 @@
// color types. Note that not all combinations are legal
PNG_COLOR_TYPE_GRAY = 0;
- PNG_COLOR_TYPE_PALETTE = (PNG_COLOR_MASK_COLOR or PNG_COLOR_MASK_PALETTE);
- PNG_COLOR_TYPE_RGB = (PNG_COLOR_MASK_COLOR);
- PNG_COLOR_TYPE_RGB_ALPHA = (PNG_COLOR_MASK_COLOR or PNG_COLOR_MASK_ALPHA);
- PNG_COLOR_TYPE_GRAY_ALPHA = (PNG_COLOR_MASK_ALPHA);
+ PNG_COLOR_TYPE_PALETTE = PNG_COLOR_MASK_COLOR or PNG_COLOR_MASK_PALETTE;
+ PNG_COLOR_TYPE_RGB = PNG_COLOR_MASK_COLOR;
+ PNG_COLOR_TYPE_RGB_ALPHA = PNG_COLOR_MASK_COLOR or PNG_COLOR_MASK_ALPHA;
+ PNG_COLOR_TYPE_GRAY_ALPHA = PNG_COLOR_MASK_ALPHA;
// aliases
PNG_COLOR_TYPE_RGBA = PNG_COLOR_TYPE_RGB_ALPHA;
--- a/hedgewars/pas2cSystem.pas Thu Apr 19 18:15:03 2012 +0200
+++ b/hedgewars/pas2cSystem.pas Thu Apr 19 23:36:20 2012 +0400
@@ -45,6 +45,9 @@
Handle = integer;
stderr = Handle;
+ png_structp = pointer;
+ png_size_t = integer;
+
var
false, true: boolean;
@@ -115,7 +118,9 @@
glclear, gldisableclientstate, gl_color_array,
glcolorpointer, gl_depth_buffer_bit, gl_quads,
glbegin, glend, gltexcoord2f, glvertex2d,
- gl_true, gl_false, glcolormask, gl_projection : procedure;
+ gl_true, gl_false, glcolormask, gl_projection,
+ gl_texture_priority, glenum, gl_clamp_to_edge,
+ gl_extensions : procedure;
TThreadId : function : integer;
BeginThread, ThreadSwitch : procedure;
@@ -128,3 +133,9 @@
_strconcat : function : string;
_strcompare, _strncompare : function : boolean;
+
+ png_structp, png_set_write_fn, png_get_io_ptr,
+ png_get_libpng_ver, png_create_write_struct,
+ png_create_info_struct, png_destroy_write_struct,
+ png_write_row, png_set_ihdr, png_write_info,
+ png_write_end : procedure;
--- a/hedgewars/uChat.pas Thu Apr 19 18:15:03 2012 +0200
+++ b/hedgewars/uChat.pas Thu Apr 19 23:36:20 2012 +0400
@@ -52,7 +52,8 @@
ChatReady: boolean;
showAll: boolean;
-const colors: array[#1..#6] of TSDL_Color = (
+const colors: array[#0..#6] of TSDL_Color = (
+ (r:$FF; g:$FF; b:$FF; unused:$FF), // unused, feel free to take it for anything
(r:$FF; g:$FF; b:$FF; unused:$FF), // chat message [White]
(r:$FF; g:$00; b:$FF; unused:$FF), // action message [Purple]
(r:$90; g:$FF; b:$90; unused:$FF), // join/leave message [Lime]
@@ -272,7 +273,7 @@
end;
procedure KeyPressChat(Key: Longword);
-const firstByteMark: array[1..4] of byte = (0, $C0, $E0, $F0);
+const firstByteMark: array[0..3] of byte = (0, $C0, $E0, $F0);
var i, btw: integer;
utf8: shortstring;
begin
@@ -322,7 +323,7 @@
Key:= Key shr 6
end;
- utf8:= char(Key or firstByteMark[btw]) + utf8;
+ utf8:= char(Key or firstByteMark[Pred(btw)]) + utf8;
if byte(InputStr.s[0]) + btw > 240 then
exit;
--- a/tools/PascalUnitSyntaxTree.hs Thu Apr 19 18:15:03 2012 +0200
+++ b/tools/PascalUnitSyntaxTree.hs Thu Apr 19 23:36:20 2012 +0400
@@ -35,6 +35,7 @@
deriving Show
data Range = Range Identifier
| RangeFromTo InitExpression InitExpression
+ | RangeInfinite
deriving Show
data Initialize = Initialize String
deriving Show
@@ -102,7 +103,7 @@
| BTBool
| BTFloat
| BTRecord [(String, BaseType)]
- | BTArray BaseType BaseType
+ | BTArray Range BaseType BaseType
| BTFunction BaseType
| BTPointerTo BaseType
| BTUnresolved String
--- a/tools/pas2c.hs Thu Apr 19 18:15:03 2012 +0200
+++ b/tools/pas2c.hs Thu Apr 19 23:36:20 2012 +0400
@@ -234,8 +234,10 @@
where
f :: TypeVarDeclaration -> State RenderState [(String, BaseType)]
f (VarDeclaration _ (ids, td) _) = mapM (\(Identifier i _) -> liftM ((,) i) $ resolveType td) ids
-resolveType (ArrayDecl (Just _) t) = liftM (BTArray BTInt) $ resolveType t
-resolveType (ArrayDecl Nothing t) = liftM (BTArray BTInt) $ resolveType t
+resolveType (ArrayDecl (Just i) t) = do
+ t' <- resolveType t
+ return $ BTArray i BTInt t'
+resolveType (ArrayDecl Nothing t) = liftM (BTArray RangeInfinite BTInt) $ resolveType t
resolveType (FunctionType t _) = liftM BTFunction $ resolveType t
resolveType (DeriveType (InitHexNumber _)) = return BTInt
resolveType (DeriveType (InitNumber _)) = return BTInt
@@ -382,13 +384,23 @@
_ -> error $ "InitRange identifier: " ++ i'
_ -> error $ "InitRange: " ++ show r
initExpr2C (InitRange (RangeFromTo (InitNumber "0") r)) = initExpr2C $ BuiltInFunction "succ" [r]
+initExpr2C (InitRange (RangeFromTo (InitChar "0") (InitChar r))) = initExpr2C $ BuiltInFunction "succ" [InitNumber r]
initExpr2C (InitRange a) = error $ show a --return $ text "<<range>>"
initExpr2C (InitSet []) = return $ text "0"
initExpr2C (InitSet a) = return $ text "<<set>>"
initExpr2C (BuiltInFunction "low" [InitReference e]) = return $
case e of
(Identifier "LongInt" _) -> int (-2^31)
- _ -> error $ show e
+ (Identifier "SmallInt" _) -> int (-2^15)
+ _ -> error $ "BuiltInFunction 'low': " ++ show e
+initExpr2C (BuiltInFunction "high" [e]) = do
+ initExpr2C e
+ t <- gets lastType
+ case t of
+ (BTArray i _ _) -> initExpr2C $ BuiltInFunction "pred" [InitRange i]
+ a -> error $ "BuiltInFunction 'high': " ++ show a
+initExpr2C (BuiltInFunction "succ" [BuiltInFunction "pred" [e]]) = initExpr2C e
+initExpr2C (BuiltInFunction "pred" [BuiltInFunction "succ" [e]]) = initExpr2C e
initExpr2C (BuiltInFunction "succ" [e]) = liftM (<> text " + 1") $ initExpr2C e
initExpr2C (BuiltInFunction "pred" [e]) = liftM (<> text " - 1") $ initExpr2C e
initExpr2C b@(BuiltInFunction _ _) = error $ show b
@@ -573,7 +585,7 @@
t <- gets lastType
ns <- gets currentScope
case t of
- (BTArray _ t') -> modify (\st -> st{lastType = t'})
+ (BTArray _ _ t') -> modify (\st -> st{lastType = t'})
(BTString) -> modify (\st -> st{lastType = BTChar})
(BTPointerTo t) -> do
t'' <- fromPointer (show t) =<< gets lastType