# HG changeset patch # User Stepan777 # Date 1341564618 -14400 # Node ID 88685fbb26791d6083a98b6dc20295bbaf3d3b90 # Parent 3cff5c7695090b9336ceccf616f57c6d91dda2b9# Parent ddb196c41387bf2eceea44c02fae4159b7db8e83 merge diff -r 3cff5c769509 -r 88685fbb2679 QTfrontend/drawmapscene.cpp --- a/QTfrontend/drawmapscene.cpp Tue Jun 26 23:29:41 2012 +0400 +++ b/QTfrontend/drawmapscene.cpp Fri Jul 06 12:50:18 2012 +0400 @@ -136,7 +136,6 @@ void DrawMapScene::showCursor() { - qDebug() << "show cursor"; if(!m_isCursorShown) addItem(m_cursor); @@ -145,7 +144,6 @@ void DrawMapScene::hideCursor() { - qDebug() << "hide cursor"; if(m_isCursorShown) removeItem(m_cursor); diff -r 3cff5c769509 -r 88685fbb2679 QTfrontend/gameuiconfig.cpp --- a/QTfrontend/gameuiconfig.cpp Tue Jun 26 23:29:41 2012 +0400 +++ b/QTfrontend/gameuiconfig.cpp Fri Jul 06 12:50:18 2012 +0400 @@ -374,7 +374,7 @@ QByteArray GameUIConfig::netPasswordHash() { - return QCryptographicHash::hash(Form->ui.pageOptions->editNetPassword->text().toLatin1(), QCryptographicHash::Md5).toHex(); + return QCryptographicHash::hash(Form->ui.pageOptions->editNetPassword->text().toUtf8(), QCryptographicHash::Md5).toHex(); } int GameUIConfig::netPasswordLength() diff -r 3cff5c769509 -r 88685fbb2679 QTfrontend/hwform.cpp --- a/QTfrontend/hwform.cpp Tue Jun 26 23:29:41 2012 +0400 +++ b/QTfrontend/hwform.cpp Fri Jul 06 12:50:18 2012 +0400 @@ -130,7 +130,7 @@ #endif gameSettings = new QSettings(cfgdir->absolutePath() + "/hedgewars.ini", QSettings::IniFormat); frontendEffects = gameSettings->value("frontend/effects", true).toBool(); - playerHash = QString(QCryptographicHash::hash(gameSettings->value("net/nick","").toString().toLatin1(), QCryptographicHash::Md5).toHex()); + playerHash = QString(QCryptographicHash::hash(gameSettings->value("net/nick","").toString().toUtf8(), QCryptographicHash::Md5).toHex()); this->setStyleSheet(styleSheet); ui.setupUi(this); @@ -981,7 +981,7 @@ } QString password = hpd->lePassword->text(); - hash = QCryptographicHash::hash(password.toLatin1(), QCryptographicHash::Md5).toHex(); + hash = QCryptographicHash::hash(password.toUtf8(), QCryptographicHash::Md5).toHex(); bool save = hpd->cbSave->isChecked(); config->setValue("net/savepassword", save); diff -r 3cff5c769509 -r 88685fbb2679 QTfrontend/team.cpp --- a/QTfrontend/team.cpp Tue Jun 26 23:29:41 2012 +0400 +++ b/QTfrontend/team.cpp Fri Jul 06 12:50:18 2012 +0400 @@ -259,7 +259,7 @@ QStringList sl; if (m_isNetTeam) { - sl.push_back(QString("eaddteam %3 %1 %2").arg(qcolor().rgb() & 0xffffff).arg(m_name).arg(QString(QCryptographicHash::hash(m_owner.toLatin1(), QCryptographicHash::Md5).toHex()))); + sl.push_back(QString("eaddteam %3 %1 %2").arg(qcolor().rgb() & 0xffffff).arg(m_name).arg(QString(QCryptographicHash::hash(m_owner.toUtf8(), QCryptographicHash::Md5).toHex()))); sl.push_back("erdriven"); } else sl.push_back(QString("eaddteam %3 %1 %2").arg(qcolor().rgb() & 0xffffff).arg(m_name).arg(playerHash)); diff -r 3cff5c769509 -r 88685fbb2679 gameServer/Actions.hs --- a/gameServer/Actions.hs Tue Jun 26 23:29:41 2012 +0400 +++ b/gameServer/Actions.hs Fri Jul 06 12:50:18 2012 +0400 @@ -160,7 +160,7 @@ s <- get put $! s{removedClients = ci `Set.delete` removedClients s} - + sp <- gets (shutdownPending . serverInfo) cls <- allClientsS io $ when (sp && null cls) $ throwIO ShutdownException @@ -251,7 +251,7 @@ chans <- liftM (map sendChan) $! sameProtoClientsS proto processAction $ AnswerClients chans ("ROOM" : "UPD" : oldRoomName : roomInfo (nick newMaster) newRoom) - + processAction (AddRoom roomName roomPassword) = do Just clId <- gets clientIndex rnc <- gets roomsClients @@ -306,16 +306,16 @@ where notReadyMessage p nicks = if p < 38 then "NOT_READY" : nicks else "CLIENT_FLAGS" : "-r" : nicks - + processAction FinishGame = do rnc <- gets roomsClients ri <- clientRoomA thisRoomChans <- liftM (map sendChan) $ roomClientsS ri clNick <- client's nick - answerRemovedTeams <- io $ + answerRemovedTeams <- io $ room'sM rnc (map (\t -> AnswerClients thisRoomChans ["REMOVE_TEAM", t]) . leftTeams . fromJust . gameInfo) ri - - mapM_ processAction $ + + mapM_ processAction $ SaveReplay : ModifyRoom (\r -> r{ @@ -326,7 +326,7 @@ : UnreadyRoomClients : answerRemovedTeams - + processAction (SendTeamRemovalMessage teamName) = do chans <- othersChans mapM_ processAction [ @@ -338,22 +338,22 @@ }) $ gameInfo r }) ] - + rnc <- gets roomsClients ri <- clientRoomA gi <- io $ room'sM rnc gameInfo ri when (isJust gi && 0 == teamsInGameNumber (fromJust gi)) $ - processAction FinishGame + processAction FinishGame where rmTeamMsg = toEngineMsg $ 'F' `B.cons` teamName - - + + processAction (RemoveTeam teamName) = do rnc <- gets roomsClients ri <- clientRoomA inGame <- io $ room'sM rnc (isJust . gameInfo) ri chans <- othersChans - mapM_ processAction $ + mapM_ processAction $ ModifyRoom (\r -> r{ teams = Prelude.filter (\t -> teamName /= teamname t) $ teams r , gameInfo = liftM (\g -> g{leftTeams = teamName : leftTeams g}) $ gameInfo r @@ -456,7 +456,7 @@ bans <- gets (bans . serverInfo) processAction $ AnswerClients [ch] ["BANLIST", B.pack $ show bans] - + processAction (KickRoomClient kickId) = do @@ -536,7 +536,7 @@ where st irnc = (length $ allRooms irnc, length $ allClients irnc) -processAction RestartServer = do +processAction RestartServer = do sp <- gets (shutdownPending . serverInfo) when (not sp) $ do sock <- gets (fromJust . serverSocket . serverInfo) diff -r 3cff5c769509 -r 88685fbb2679 gameServer/ClientIO.hs --- a/gameServer/ClientIO.hs Tue Jun 26 23:29:41 2012 +0400 +++ b/gameServer/ClientIO.hs Fri Jul 06 12:50:18 2012 +0400 @@ -43,16 +43,18 @@ clientRecvLoop :: Socket -> Chan CoreMessage -> Chan [B.ByteString] -> ClientIndex -> (forall a. IO a -> IO a) -> IO () clientRecvLoop s chan clChan ci restore = - myThreadId >>= + (myThreadId >>= \t -> (restore $ forkIO (clientSendLoop s t clChan ci) >> listenLoop s chan ci >> return "Connection closed") + `Exception.catch` (\(e :: ShutdownThreadException) -> return . B.pack . show $ e) `Exception.catch` (\(e :: Exception.IOException) -> return . B.pack . show $ e) - `Exception.catch` (\(e :: ShutdownThreadException) -> return . B.pack . show $ e) `Exception.catch` (\(e :: Exception.SomeException) -> return . B.pack . show $ e) - >>= clientOff >> remove + >>= clientOff) `Exception.finally` remove where clientOff msg = writeChan chan $ ClientMessage (ci, ["QUIT", msg]) - remove = writeChan chan $ Remove ci + remove = do + clientOff "Client is in some weird state" + writeChan chan $ Remove ci diff -r 3cff5c769509 -r 88685fbb2679 gameServer/CoreTypes.hs --- a/gameServer/CoreTypes.hs Tue Jun 26 23:29:41 2012 +0400 +++ b/gameServer/CoreTypes.hs Fri Jul 06 12:50:18 2012 +0400 @@ -62,7 +62,7 @@ hedgehogs :: [HedgehogInfo] } deriving (Show, Read) - + data GameInfo = GameInfo { @@ -74,9 +74,9 @@ giMapParams :: Map.Map B.ByteString B.ByteString, giParams :: Map.Map B.ByteString [B.ByteString] } deriving (Show, Read) - ---newGameInfo :: -> GameInfo -newGameInfo = + +--newGameInfo :: -> GameInfo +newGameInfo = GameInfo Data.Sequence.empty [] diff -r 3cff5c769509 -r 88685fbb2679 gameServer/HWProtoInRoomState.hs --- a/gameServer/HWProtoInRoomState.hs Tue Jun 26 23:29:41 2012 +0400 +++ b/gameServer/HWProtoInRoomState.hs Fri Jul 06 12:50:18 2012 +0400 @@ -79,10 +79,10 @@ hhsList [_] = error "Hedgehogs list with odd elements number" hhsList (n:h:hhs) = HedgehogInfo n h : hhsList hhs newTeamHHNum r = min 4 (canAddNumber r) - maxTeams r + maxTeams r | roomProto r < 38 = 6 | otherwise = 8 - + handleCmd_inRoom ["REMOVE_TEAM", tName] = do (ci, _) <- ask @@ -171,7 +171,7 @@ cl <- thisClient rm <- thisRoom chans <- roomClientsChans - + let allPlayersRegistered = all ((<) 0 . B.length . webPassword . client rnc . teamownerId) $ teams rm if isMaster cl && playersIn rm == readyPlayers rm && not (isJust $ gameInfo rm) then @@ -247,7 +247,7 @@ rs <- allRoomInfos rm <- thisRoom chans <- sameProtoChans - + return $ if not $ isMaster cl then [ProtocolError "Not room master"] diff -r 3cff5c769509 -r 88685fbb2679 gameServer/HWProtoLobbyState.hs --- a/gameServer/HWProtoLobbyState.hs Tue Jun 26 23:29:41 2012 +0400 +++ b/gameServer/HWProtoLobbyState.hs Fri Jul 06 12:50:18 2012 +0400 @@ -71,7 +71,7 @@ let nicks = map nick jRoomClients let chans = map sendChan (cl : jRoomClients) return $ - if isNothing maybeRI || not sameProto then + if isNothing maybeRI || not sameProto then [Warning "No such room"] else if isRestrictedJoins jRoom then [Warning "Joining restricted"] @@ -147,12 +147,12 @@ cl <- thisClient banId <- clientByNick banNick return [BanClient 60 reason (fromJust banId) | isAdministrator cl && isJust banId && fromJust banId /= ci] - + handleCmd_lobby ["BANIP", ip, reason, duration] = do (ci, _) <- ask cl <- thisClient return [BanIP ip (readInt_ duration) reason | isAdministrator cl] - + handleCmd_lobby ["BANLIST"] = do (ci, _) <- ask cl <- thisClient @@ -172,7 +172,7 @@ return [ModifyServerInfo (\si -> si{latestReleaseVersion = readNum}) | isAdministrator cl && readNum > 0] where readNum = readInt_ protoNum - + handleCmd_lobby ["GET_SERVER_VAR"] = do cl <- thisClient return [SendServerVars | isAdministrator cl] diff -r 3cff5c769509 -r 88685fbb2679 gameServer/OfficialServer/DBInteraction.hs --- a/gameServer/OfficialServer/DBInteraction.hs Tue Jun 26 23:29:41 2012 +0400 +++ b/gameServer/OfficialServer/DBInteraction.hs Fri Jul 06 12:50:18 2012 +0400 @@ -60,7 +60,7 @@ CheckAccount clId clUid clNick _ -> do let cacheEntry = clNick `Map.lookup` accountsCache currentTime <- getCurrentTime - if (isNothing cacheEntry) || (currentTime `diffUTCTime` (fst . fromJust) cacheEntry > 2 * 24 * 60 * 60) then + if (isNothing cacheEntry) || (currentTime `diffUTCTime` (fst . fromJust) cacheEntry > 10 * 60) then do SIO.hPutStrLn hIn $ show q hFlush hIn diff -r 3cff5c769509 -r 88685fbb2679 hedgewars/GSHandlers.inc --- a/hedgewars/GSHandlers.inc Tue Jun 26 23:29:41 2012 +0400 +++ b/hedgewars/GSHandlers.inc Fri Jul 06 12:50:18 2012 +0400 @@ -2120,15 +2120,14 @@ voices. Reinforcements voices is heard for active team, not team-to-be. Either that or change crate spawn from end of turn to start, although that has its own complexities. *) // Abuse a couple of gear values to track origin - Gear^.Angle:= hwRound(Gear^.X); - Gear^.Power:= hwRound(Gear^.Y); + Gear^.Angle:= hwRound(Gear^.Y); Gear^.Tag:= random(2); inc(Gear^.Timer) end; if Gear^.Timer < 1833 then inc(Gear^.Timer); if Gear^.Timer = 1000 then begin - sparkles:= AddVisualGear(Gear^.Angle, Gear^.Power, vgtDust, 1); + sparkles:= AddVisualGear(hwRound(Gear^.X), Gear^.Angle, vgtDust, 1); if sparkles <> nil then begin sparkles^.dX:= 0; @@ -2751,16 +2750,17 @@ procedure doStepSwitcherWork(Gear: PGear); var HHGear: PGear; + hedgehog: PHedgehog; State: Longword; begin AllInactive := false; if ((Gear^.Message and (not gmSwitch)) <> 0) or (TurnTimeLeft = 0) then begin - HHGear := Gear^.Hedgehog^.Gear; + hedgehog := Gear^.Hedgehog; //Msg := Gear^.Message and (not gmSwitch); DeleteGear(Gear); - ApplyAmmoChanges(HHGear^.Hedgehog^); + ApplyAmmoChanges(hedgehog^); HHGear := CurrentHedgehog^.Gear; ApplyAmmoChanges(HHGear^.Hedgehog^); @@ -3193,23 +3193,22 @@ //////////////////////////////////////////////////////////////////////////////// procedure doStepSeductionWork(Gear: PGear); var i: LongInt; - hogs: TPGearArray; + hogs: PGearArrayS; begin AllInactive := false; hogs := GearsNear(Gear^.X, Gear^.Y, gtHedgehog, Gear^.Radius); - if Length(hogs) > 0 then - begin - for i:= 0 to Length(hogs) - 1 do - begin - if hogs[i] <> CurrentHedgehog^.Gear then + if hogs.size > 0 then + begin + for i:= 0 to hogs.size - 1 do + with hogs.ar^[i]^ do begin - //d:= Distance(Gear^.X - hogs[i]^.X, Gear^.Y - hogs[i]^.Y); - hogs[i]^.dX:= _50 * cGravity * (Gear^.X - hogs[i]^.X) / _25; - //if Gear^.X < hogs[i]^.X then hogs[i]^.dX.isNegative:= true; - hogs[i]^.dY:= -_450 * cGravity; - hogs[i]^.Active:= true; - end - end; + if hogs.ar^[i] <> CurrentHedgehog^.Gear then + begin + dX:= _50 * cGravity * (Gear^.X - X) / _25; + dY:= -_450 * cGravity; + Active:= true; + end + end; end ; AfterAttack; DeleteGear(Gear); @@ -3331,10 +3330,10 @@ if (Gear^.Timer mod 30) = 0 then AddVisualGear(hwRound(Gear^.X + _20 * Gear^.dX), hwRound(Gear^.Y + _20 * Gear^.dY), vgtDust); if (CheckGearDrowning(Gear)) then - begin + begin StopSoundChan(Gear^.SoundChannel); exit - end + end end; if GameTicks > Gear^.FlightTime then @@ -3425,8 +3424,9 @@ end else if ((Gear^.State and gsttmpFlag) <> 0) and (Gear^.Tag <> 0) then begin - if Gear^.Timer > 0 then dec(Gear^.Timer); - if Gear^.Timer = 0 then + if Gear^.Timer > 0 then + dec(Gear^.Timer) + else begin doMakeExplosion(hwRound(Gear^.X), hwRound(Gear^.Y), 30, Gear^.Hedgehog, EXPLAutoSound); DeleteGear(Gear); @@ -4411,12 +4411,13 @@ ty := 0; // avoid compiler hints - if ((y and LAND_HEIGHT_MASK) = 0) and ((x and LAND_WIDTH_MASK) = 0) and (Land[y, x] and ($FF00 and not lfBouncy) <> 0) then + if ((y and LAND_HEIGHT_MASK) = 0) and ((x and LAND_WIDTH_MASK) = 0) and (Land[y, x] > 255) then begin Gear^.State := Gear^.State or gstCollision; Gear^.State := Gear^.State and (not gstMoving); - if not CalcSlopeTangent(Gear, x, y, tx, ty, 255) + if (Land[y, x] and lfBouncy <> 0) + or not CalcSlopeTangent(Gear, x, y, tx, ty, 255) or (DistanceI(tx,ty) < _12) then // reject shots at too irregular terrain begin loadNewPortalBall(Gear, true); @@ -5060,7 +5061,7 @@ //////////////////////////////////////////////////////////////////////////////// procedure doStepResurrectorWork(Gear: PGear); var - graves: TPGearArray; + graves: PGearArrayS; resgear: PGear; hh: PHedgehog; i: LongInt; @@ -5095,7 +5096,7 @@ graves := GearsNear(Gear^.X, Gear^.Y, gtGrave, Gear^.Radius); - if Length(graves) = 0 then + if graves.size = 0 then begin StopSoundChan(Gear^.SoundChannel); Gear^.Timer := 250; @@ -5105,12 +5106,12 @@ if ((Gear^.Message and gmAttack) <> 0) and (hh^.Gear^.Health > 0) and (TurnTimeLeft > 0) then begin - if Length(graves) <= Gear^.Tag then Gear^.Tag:= 0; + if graves.size <= Gear^.Tag then Gear^.Tag:= 0; dec(hh^.Gear^.Health); if (hh^.Gear^.Health = 0) and (hh^.Gear^.Damage = 0) then hh^.Gear^.Damage:= 1; RenderHealth(hh^); - inc(graves[Gear^.Tag]^.Health); + inc(graves.ar^[Gear^.Tag]^.Health); inc(Gear^.Tag) {-for i:= 0 to High(graves) do begin if hh^.Gear^.Health > 0 then begin @@ -5122,14 +5123,14 @@ else begin // now really resurrect the hogs with the hp saved in the graves - for i:= 0 to Length(graves) - 1 do - if graves[i]^.Health > 0 then + for i:= 0 to graves.size - 1 do + if graves.ar^[i]^.Health > 0 then begin - resgear := AddGear(hwRound(graves[i]^.X), hwRound(graves[i]^.Y), gtHedgehog, gstWait, _0, _0, 0); - resgear^.Hedgehog := graves[i]^.Hedgehog; - resgear^.Health := graves[i]^.Health; - PHedgehog(graves[i]^.Hedgehog)^.Gear := resgear; - DeleteGear(graves[i]); + resgear := AddGear(hwRound(graves.ar^[i]^.X), hwRound(graves.ar^[i]^.Y), gtHedgehog, gstWait, _0, _0, 0); + resgear^.Hedgehog := graves.ar^[i]^.Hedgehog; + resgear^.Health := graves.ar^[i]^.Health; + PHedgehog(graves.ar^[i]^.Hedgehog)^.Gear := resgear; + DeleteGear(graves.ar^[i]); RenderHealth(resgear^.Hedgehog^); RecountTeamHealth(resgear^.Hedgehog^.Team); resgear^.Hedgehog^.Effects[heResurrected]:= 1; @@ -5151,18 +5152,18 @@ procedure doStepResurrector(Gear: PGear); var - graves: TPGearArray; + graves: PGearArrayS; i: LongInt; begin AllInactive := false; graves := GearsNear(Gear^.X, Gear^.Y, gtGrave, Gear^.Radius); - if Length(graves) > 0 then - begin - for i:= 0 to Length(graves) - 1 do + if graves.size > 0 then + begin + for i:= 0 to graves.size - 1 do begin - PHedgehog(graves[i]^.Hedgehog)^.Gear := nil; - graves[i]^.Health := 0; + PHedgehog(graves.ar^[i]^.Hedgehog)^.Gear := nil; + graves.ar^[i]^.Health := 0; end; Gear^.doStep := @doStepResurrectorWork; end @@ -5377,7 +5378,7 @@ end; Gear^.Pos:= 4; // This condition might need tweaking - Gear^.Timer:= GetRandom(cHedgehogTurnTime*TeamsCount)+cHedgehogTurnTime + Gear^.Timer:= GetRandom(cHedgehogTurnTime*TeamsCount*2)+cHedgehogTurnTime*2 end; if (Gear^.Pos = 4) then @@ -5481,7 +5482,7 @@ HHGear, iter: PGear; ndX, ndY: hwFloat; i, t, gX, gY: LongInt; - hogs: TPGearArray; + hogs: PGearArrayS; begin HHGear := Gear^.Hedgehog^.Gear; if (Gear^.Health = 0) or (HHGear = nil) or (HHGear^.Damage <> 0) then @@ -5545,9 +5546,9 @@ // freeze nearby hogs if GameTicks mod 10 = 0 then dec(Gear^.Health); hogs := GearsNear(Gear^.X, Gear^.Y, gtHedgehog, Gear^.Radius); - if Length(hogs) > 0 then - for i:= 0 to Length(hogs) - 1 do - if hogs[i] <> HHGear then + if hogs.size > 0 then + for i:= 0 to hogs.size - 1 do + if hogs.ar^[i] <> HHGear then begin //if Gear^.Hedgehog^.Effects[heFrozen]:= 0; end; diff -r 3cff5c769509 -r 88685fbb2679 hedgewars/uAmmos.pas --- a/hedgewars/uAmmos.pas Tue Jun 26 23:29:41 2012 +0400 +++ b/hedgewars/uAmmos.pas Fri Jul 06 12:50:18 2012 +0400 @@ -32,6 +32,7 @@ procedure SetAmmoReinforcement(var s: shortstring); procedure AssignStores; procedure AddAmmo(var Hedgehog: THedgehog; ammo: TAmmoType); +procedure AddAmmo(var Hedgehog: THedgehog; ammo: TAmmoType; amt: LongWord); procedure SetAmmo(var Hedgehog: THedgehog; ammo: TAmmoType; cnt: LongWord); function HHHasAmmo(var Hedgehog: THedgehog; Ammo: TAmmoType): LongWord; procedure PackAmmo(Ammo: PHHAmmo; Slot: LongInt); @@ -188,7 +189,7 @@ end end; -procedure AddAmmo(var Hedgehog: THedgehog; ammo: TAmmoType); +procedure AddAmmo(var Hedgehog: THedgehog; ammo: TAmmoType; amt: LongWord); var cnt: LongWord; a: PAmmo; begin @@ -199,11 +200,16 @@ cnt:= 0; if (cnt <> AMMO_INFINITE) then begin - inc(cnt, Ammoz[ammo].NumberInCase); + inc(cnt, amt); SetAmmo(Hedgehog, ammo, cnt) end end; +procedure AddAmmo(var Hedgehog: THedgehog; ammo: TAmmoType); +begin + AddAmmo(Hedgehog, ammo, Ammoz[ammo].NumberInCase); +end; + procedure SetAmmo(var Hedgehog: THedgehog; ammo: TAmmoType; cnt: LongWord); var ammos: TAmmoCounts; slot, ami: LongInt; @@ -297,22 +303,23 @@ procedure ApplyAngleBounds(var Hedgehog: THedgehog; AmmoType: TAmmoType); begin -with Hedgehog do - begin - CurMinAngle:= Ammoz[AmmoType].minAngle; - if Ammoz[AmmoType].maxAngle <> 0 then - CurMaxAngle:= Ammoz[AmmoType].maxAngle - else - CurMaxAngle:= cMaxAngle; +if Hedgehog.Gear <> nil then + with Hedgehog do + begin + CurMinAngle:= Ammoz[AmmoType].minAngle; + if Ammoz[AmmoType].maxAngle <> 0 then + CurMaxAngle:= Ammoz[AmmoType].maxAngle + else + CurMaxAngle:= cMaxAngle; - with Hedgehog.Gear^ do - begin - if Angle < CurMinAngle then - Angle:= CurMinAngle; - if Angle > CurMaxAngle then - Angle:= CurMaxAngle; + with Hedgehog.Gear^ do + begin + if Angle < CurMinAngle then + Angle:= CurMinAngle; + if Angle > CurMaxAngle then + Angle:= CurMaxAngle; + end end - end end; procedure SwitchToFirstLegalAmmo(var Hedgehog: THedgehog); @@ -374,12 +381,12 @@ AddCaption(s, Team^.Clan^.Color, capgrpAmmoinfo); if (Propz and ammoprop_NeedTarget) <> 0 then begin - Gear^.State:= Gear^.State or gstHHChooseTarget; + if Gear <> nil then Gear^.State:= Gear^.State or gstHHChooseTarget; isCursorVisible:= true end else begin - Gear^.State:= Gear^.State and not gstHHChooseTarget; + if Gear <> nil then Gear^.State:= Gear^.State and not gstHHChooseTarget; isCursorVisible:= false end; end diff -r 3cff5c769509 -r 88685fbb2679 hedgewars/uCollisions.pas --- a/hedgewars/uCollisions.pas Tue Jun 26 23:29:41 2012 +0400 +++ b/hedgewars/uCollisions.pas Fri Jul 06 12:50:18 2012 +0400 @@ -136,7 +136,6 @@ function TestCollisionXwithGear(Gear: PGear; Dir: LongInt): boolean; var x, y, i: LongInt; - TestWord: LongWord; begin // Special case to emulate the old intersect gear clearing, but with a bit of slop for pixel overlap if (Gear^.CollisionMask = $FF7F) and (Gear^.Hedgehog <> nil) and (Gear^.Hedgehog^.Gear <> nil) and @@ -167,7 +166,6 @@ function TestCollisionYwithGear(Gear: PGear; Dir: LongInt): Word; var x, y, i: LongInt; - TestWord: LongWord; begin // Special case to emulate the old intersect gear clearing, but with a bit of slop for pixel overlap if (Gear^.CollisionMask = $FF7F) and (Gear^.Hedgehog <> nil) and (Gear^.Hedgehog^.Gear <> nil) and diff -r 3cff5c769509 -r 88685fbb2679 hedgewars/uGears.pas --- a/hedgewars/uGears.pas Tue Jun 26 23:29:41 2012 +0400 +++ b/hedgewars/uGears.pas Fri Jul 06 12:50:18 2012 +0400 @@ -37,7 +37,7 @@ procedure initModule; procedure freeModule; -function SpawnCustomCrateAt(x, y: LongInt; crate: TCrateType; content: Longword ): PGear; +function SpawnCustomCrateAt(x, y: LongInt; crate: TCrateType; content, cnt: Longword): PGear; function SpawnFakeCrateAt(x, y: LongInt; crate: TCrateType; explode: boolean; poison: boolean ): PGear; function GetAmmo(Hedgehog: PHedgehog): TAmmoType; function GetUtility(Hedgehog: PHedgehog): TAmmoType; @@ -65,7 +65,7 @@ procedure AmmoShove(Ammo: PGear; Damage, Power: LongInt); forward; //procedure AmmoFlameWork(Ammo: PGear); forward; -function GearsNear(X, Y: hwFloat; Kind: TGearType; r: LongInt): TPGearArray; forward; +function GearsNear(X, Y: hwFloat; Kind: TGearType; r: LongInt): PGearArrayS; forward; procedure SpawnBoxOfSmth; forward; procedure ShotgunShot(Gear: PGear); forward; procedure doStepCase(Gear: PGear); forward; @@ -871,25 +871,30 @@ end end; -function GearsNear(X, Y: hwFloat; Kind: TGearType; r: LongInt): TPGearArray; +var GearsNearArray : TPGearArray; +function GearsNear(X, Y: hwFloat; Kind: TGearType; r: LongInt): PGearArrayS; var t: PGear; - l: Longword; + s: Longword; begin r:= r*r; - GearsNear := nil; + s:= 0; + SetLength(GearsNearArray, s); t := GearsList; while t <> nil do begin if (t^.Kind = Kind) and ((X - t^.X)*(X - t^.X) + (Y - t^.Y)*(Y-t^.Y) < int2hwFloat(r)) then begin - l:= Length(GearsNear); - SetLength(GearsNear, l + 1); - GearsNear[l] := t; + inc(s); + SetLength(GearsNearArray, s); + GearsNearArray[s - 1] := t; end; t := t^.NextGear; end; + + GearsNear.size:= s; + GearsNear.ar:= @GearsNearArray end; {procedure AmmoFlameWork(Ammo: PGear); @@ -928,7 +933,7 @@ CountGears:= count; end; -function SpawnCustomCrateAt(x, y: LongInt; crate: TCrateType; content: Longword): PGear; +function SpawnCustomCrateAt(x, y: LongInt; crate: TCrateType; content, cnt: Longword): PGear; begin FollowGear := AddGear(x, y, gtCase, 0, _0, _0, 0); cCaseFactor := 0; @@ -936,6 +941,8 @@ if (crate <> HealthCrate) and (content > ord(High(TAmmoType))) then content := ord(High(TAmmoType)); + FollowGear^.Power:= cnt; + case crate of HealthCrate: begin diff -r 3cff5c769509 -r 88685fbb2679 hedgewars/uGearsHedgehog.pas --- a/hedgewars/uGearsHedgehog.pas Tue Jun 26 23:29:41 2012 +0400 +++ b/hedgewars/uGearsHedgehog.pas Fri Jul 06 12:50:18 2012 +0400 @@ -596,7 +596,8 @@ else a:= GetAmmo(HH^.Hedgehog) end; - AddAmmo(HH^.Hedgehog^, a); + if Gear^.Power <> 0 then AddAmmo(HH^.Hedgehog^, a, Gear^.Power) + else AddAmmo(HH^.Hedgehog^, a); // Possibly needs to check shared clan ammo game flag once added. // On the other hand, no obvious reason that clan members shouldn't know what ammo another clan member picked up if (not (HH^.Hedgehog^.Team^.ExtDriven @@ -604,7 +605,10 @@ or (HH^.Hedgehog^.Team^.Clan^.ClanIndex = LocalClan) or (GameType in [gmtDemo, gmtRecord]) then begin - s:= trammo[Ammoz[a].NameId] + ' (+' + IntToStr(Ammoz[a].NumberInCase) + ')'; + if Gear^.Power <> 0 then + s:= trammo[Ammoz[a].NameId] + ' (+' + IntToStr(Gear^.Power) + ')' + else + s:= trammo[Ammoz[a].NameId] + ' (+' + IntToStr(Ammoz[a].NumberInCase) + ')'; AddCaption(s, HH^.Hedgehog^.Team^.Clan^.Color, capgrpAmmoinfo); // show ammo icon diff -r 3cff5c769509 -r 88685fbb2679 hedgewars/uGearsList.pas --- a/hedgewars/uGearsList.pas Tue Jun 26 23:29:41 2012 +0400 +++ b/hedgewars/uGearsList.pas Fri Jul 06 12:50:18 2012 +0400 @@ -101,6 +101,7 @@ // Define ammo association, if any. gear^.AmmoType:= GearKindAmmoTypeMap[Kind]; gear^.CollisionMask:= $FFFF; +gear^.Power:= 0; if CurrentHedgehog <> nil then gear^.Hedgehog:= CurrentHedgehog; diff -r 3cff5c769509 -r 88685fbb2679 hedgewars/uGearsRender.pas --- a/hedgewars/uGearsRender.pas Tue Jun 26 23:29:41 2012 +0400 +++ b/hedgewars/uGearsRender.pas Fri Jul 06 12:50:18 2012 +0400 @@ -1015,10 +1015,10 @@ DrawSprite(sprUtility, x - 24, y - 24, i); end; end; - if Gear^.Timer <= 1833 then + if Gear^.Timer < 1833 then begin DrawTextureRotatedF(SpritesData[sprPortal].texture, min(abs(1.25 - (Gear^.Timer mod 1333) / 400), 1.25), 0, 0, - Gear^.Angle+WorldDx, Gear^.Power+WorldDy-16, 4+Gear^.Tag, 1, 32, 32, 270); + x, Gear^.Angle+WorldDy-16, 4+Gear^.Tag, 1, 32, 32, 270); end end; gtExplosives: begin diff -r 3cff5c769509 -r 88685fbb2679 hedgewars/uScript.pas --- a/hedgewars/uScript.pas Tue Jun 26 23:29:41 2012 +0400 +++ b/hedgewars/uScript.pas Fri Jul 06 12:50:18 2012 +0400 @@ -184,10 +184,19 @@ end; function lc_parsecommand(L : Plua_State) : LongInt; Cdecl; +var t: PChar; + i,c: LongWord; + s: shortstring; begin if lua_gettop(L) = 1 then begin - ParseCommand(lua_tostring(L ,1), true); + t:= lua_tolstring(L,1,@c); + + for i:= 1 to c do s[i]:= t[i-1]; + s[0]:= char(c); + + ParseCommand(s, true); + end else LuaError('Lua: Wrong number of parameters passed to ParseCommand!'); @@ -313,7 +322,7 @@ health:= lua_tointeger(L, 3) else health:= cHealthCaseAmount; - gear := SpawnCustomCrateAt(lua_tointeger(L, 1), lua_tointeger(L, 2), HealthCrate, health); + gear := SpawnCustomCrateAt(lua_tointeger(L, 1), lua_tointeger(L, 2), HealthCrate, health, 0); if gear <> nil then lua_pushinteger(L, gear^.uid) else @@ -325,14 +334,16 @@ function lc_spawnammocrate(L: PLua_State): LongInt; Cdecl; var gear: PGear; begin - if lua_gettop(L) <> 3 then + if (lua_gettop(L) <> 3) and (lua_gettop(L) <> 4) then begin LuaError('Lua: Wrong number of parameters passed to SpawnAmmoCrate!'); lua_pushnil(L); end else begin - gear := SpawnCustomCrateAt(lua_tointeger(L, 1), lua_tointeger(L, 2), AmmoCrate, lua_tointeger(L, 3)); + if (lua_gettop(L) = 3) then + gear := SpawnCustomCrateAt(lua_tointeger(L, 1), lua_tointeger(L, 2), AmmoCrate, lua_tointeger(L, 3), 0) + else gear := SpawnCustomCrateAt(lua_tointeger(L, 1), lua_tointeger(L, 2), AmmoCrate, lua_tointeger(L, 3), lua_tointeger(L, 4)); if gear <> nil then lua_pushinteger(L, gear^.uid) else @@ -344,15 +355,16 @@ function lc_spawnutilitycrate(L: PLua_State): LongInt; Cdecl; var gear: PGear; begin - if lua_gettop(L) <> 3 then + if (lua_gettop(L) <> 3) and (lua_gettop(L) <> 4) then begin LuaError('Lua: Wrong number of parameters passed to SpawnUtilityCrate!'); lua_pushnil(L); end else - begin - gear := SpawnCustomCrateAt(lua_tointeger(L, 1), lua_tointeger(L, 2), - UtilityCrate, lua_tointeger(L, 3)); + begin + if (lua_gettop(L) = 3) then + gear := SpawnCustomCrateAt(lua_tointeger(L, 1), lua_tointeger(L, 2), UtilityCrate, lua_tointeger(L, 3), 0) + else gear := SpawnCustomCrateAt(lua_tointeger(L, 1), lua_tointeger(L, 2), UtilityCrate, lua_tointeger(L, 3), lua_tointeger(L, 4)); if gear <> nil then lua_pushinteger(L, gear^.uid) else diff -r 3cff5c769509 -r 88685fbb2679 hedgewars/uTypes.pas --- a/hedgewars/uTypes.pas Tue Jun 26 23:29:41 2012 +0400 +++ b/hedgewars/uTypes.pas Fri Jul 06 12:50:18 2012 +0400 @@ -260,6 +260,10 @@ LastDamage: PHedgehog; end; TPGearArray = array of PGear; + PGearArrayS = record + size: LongWord; + ar: ^TPGearArray; + end; PVisualGear = ^TVisualGear; TVGearStepProcedure = procedure (Gear: PVisualGear; Steps: Longword); diff -r 3cff5c769509 -r 88685fbb2679 hedgewars/uWorld.pas --- a/hedgewars/uWorld.pas Tue Jun 26 23:29:41 2012 +0400 +++ b/hedgewars/uWorld.pas Fri Jul 06 12:50:18 2012 +0400 @@ -1620,9 +1620,10 @@ isFirstFrame:= false end; +var PrevSentPointTime: LongWord = 0; + procedure MoveCamera; var EdgesDist, wdy, shs,z: LongInt; - PrevSentPointTime: LongWord = 0; begin {$IFNDEF MOBILE} if (not (CurrentTeam^.ExtDriven and isCursorVisible and (not bShowAmmoMenu))) and cHasFocus and (GameState <> gsConfirm) then @@ -1632,7 +1633,7 @@ if not PlacingHogs and (FollowGear <> nil) and (not isCursorVisible) and (not bShowAmmoMenu) and (not fastUntilLag) then if (not autoCameraOn) then FollowGear:= nil - else + else if ((abs(CursorPoint.X - prevPoint.X) + abs(CursorPoint.Y - prevpoint.Y)) > 4) then begin FollowGear:= nil; @@ -1852,6 +1853,7 @@ Frames:= 0; WorldDx:= -512; WorldDy:= -256; + PrevSentPointTime:= 0; FPS:= 0; CountTicks:= 0; diff -r 3cff5c769509 -r 88685fbb2679 project_files/HedgewarsMobile/Classes/HWUtils.m --- a/project_files/HedgewarsMobile/Classes/HWUtils.m Tue Jun 26 23:29:41 2012 +0400 +++ b/project_files/HedgewarsMobile/Classes/HWUtils.m Fri Jul 06 12:50:18 2012 +0400 @@ -22,7 +22,6 @@ #import #import #import -#import "SDL_uikitwindow.h" static NSString *cachedModel = nil; diff -r 3cff5c769509 -r 88685fbb2679 project_files/HedgewarsMobile/Classes/HedgewarsAppDelegate.h --- a/project_files/HedgewarsMobile/Classes/HedgewarsAppDelegate.h Tue Jun 26 23:29:41 2012 +0400 +++ b/project_files/HedgewarsMobile/Classes/HedgewarsAppDelegate.h Fri Jul 06 12:50:18 2012 +0400 @@ -18,7 +18,7 @@ #import -#import "SDL_uikitappdelegate.h" +#import "../src/video/uikit/SDL_uikitappdelegate.h" @class MainMenuViewController; diff -r 3cff5c769509 -r 88685fbb2679 project_files/HedgewarsMobile/Hedgewars.xcodeproj/project.pbxproj --- a/project_files/HedgewarsMobile/Hedgewars.xcodeproj/project.pbxproj Tue Jun 26 23:29:41 2012 +0400 +++ b/project_files/HedgewarsMobile/Hedgewars.xcodeproj/project.pbxproj Fri Jul 06 12:50:18 2012 +0400 @@ -78,6 +78,7 @@ 615E76BE14E4421200FBA131 /* MGSplitViewController.m in Sources */ = {isa = PBXBuildFile; fileRef = 615E76BB14E4421200FBA131 /* MGSplitViewController.m */; }; 615FEAE212A2A6640098EE92 /* localplayButton~ipad.png in Resources */ = {isa = PBXBuildFile; fileRef = 615FEADF12A2A6640098EE92 /* localplayButton~ipad.png */; }; 615FEAE312A2A6640098EE92 /* localplayButton~iphone.png in Resources */ = {isa = PBXBuildFile; fileRef = 615FEAE012A2A6640098EE92 /* localplayButton~iphone.png */; }; + 616065A8159A71FD00CFAEF4 /* hwclassic.mp3 in Resources */ = {isa = PBXBuildFile; fileRef = 616065A7159A71FD00CFAEF4 /* hwclassic.mp3 */; }; 616245D114E6160200CC97FB /* libFreetype.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 6162456714E6159C00CC97FB /* libFreetype.a */; }; 6163EE7E11CC2600001C0453 /* SingleWeaponViewController.m in Sources */ = {isa = PBXBuildFile; fileRef = 6163EE7D11CC2600001C0453 /* SingleWeaponViewController.m */; }; 6165920D11CA9BA200D6E256 /* FlagsViewController.m in Sources */ = {isa = PBXBuildFile; fileRef = 616591E111CA9BA200D6E256 /* FlagsViewController.m */; }; @@ -182,7 +183,7 @@ 619C5AF4124F7E3100D041AE /* LuaPas.pas in Sources */ = {isa = PBXBuildFile; fileRef = 619C5AF3124F7E3100D041AE /* LuaPas.pas */; }; 619C5BA2124FA59000D041AE /* MapPreviewButtonView.m in Sources */ = {isa = PBXBuildFile; fileRef = 619C5BA1124FA59000D041AE /* MapPreviewButtonView.m */; }; 61A1188511683A8C00359010 /* CoreGraphics.framework in Frameworks */ = {isa = PBXBuildFile; fileRef = 61A117FE1168322700359010 /* CoreGraphics.framework */; settings = {ATTRIBUTES = (Required, ); }; }; - 61A19AFC14D20170004B1E6D /* libSDL.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 61A19AEA14D2010A004B1E6D /* libSDL.a */; }; + 61A19AFC14D20170004B1E6D /* libSDL2.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 61A19AEA14D2010A004B1E6D /* libSDL2.a */; }; 61A19B7714D20B7A004B1E6D /* libSDL_image.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 61A19B6614D20B6C004B1E6D /* libSDL_image.a */; }; 61A19BC714D20CE7004B1E6D /* libSDL_ttf.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 61A19BC614D20CDA004B1E6D /* libSDL_ttf.a */; }; 61A19BFA14D20D95004B1E6D /* libSDL_net.a in Frameworks */ = {isa = PBXBuildFile; fileRef = 61A19BF914D20D83004B1E6D /* libSDL_net.a */; }; @@ -402,6 +403,7 @@ 615FEADE12A2A6640098EE92 /* localplayButton@2x~iphone.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = "localplayButton@2x~iphone.png"; path = "Resources/Frontend/localplayButton@2x~iphone.png"; sourceTree = ""; }; 615FEADF12A2A6640098EE92 /* localplayButton~ipad.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = "localplayButton~ipad.png"; path = "Resources/Frontend/localplayButton~ipad.png"; sourceTree = ""; }; 615FEAE012A2A6640098EE92 /* localplayButton~iphone.png */ = {isa = PBXFileReference; lastKnownFileType = image.png; name = "localplayButton~iphone.png"; path = "Resources/Frontend/localplayButton~iphone.png"; sourceTree = ""; }; + 616065A7159A71FD00CFAEF4 /* hwclassic.mp3 */ = {isa = PBXFileReference; lastKnownFileType = audio.mp3; name = hwclassic.mp3; path = Resources/hwclassic.mp3; sourceTree = ""; }; 6163EE7C11CC2600001C0453 /* SingleWeaponViewController.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = SingleWeaponViewController.h; sourceTree = ""; }; 6163EE7D11CC2600001C0453 /* SingleWeaponViewController.m */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.objc; path = SingleWeaponViewController.m; sourceTree = ""; }; 61641FE31437CDAA006E049C /* DefinesAndMacros.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; name = DefinesAndMacros.h; path = Classes/DefinesAndMacros.h; sourceTree = ""; }; @@ -641,7 +643,7 @@ 616245D114E6160200CC97FB /* libFreetype.a in Frameworks */, 619599451364C83D00B429B6 /* libLua.a in Frameworks */, 6195981F1364BCEF00B429B6 /* libTremor.a in Frameworks */, - 61A19AFC14D20170004B1E6D /* libSDL.a in Frameworks */, + 61A19AFC14D20170004B1E6D /* libSDL2.a in Frameworks */, 61A19B7714D20B7A004B1E6D /* libSDL_image.a in Frameworks */, 61A19C2414D20F5A004B1E6D /* libSDL_mixer.a in Frameworks */, 61A19BFA14D20D95004B1E6D /* libSDL_net.a in Frameworks */, @@ -808,6 +810,7 @@ 612CABCA1391D3D1005E9596 /* Sounds */ = { isa = PBXGroup; children = ( + 616065A7159A71FD00CFAEF4 /* hwclassic.mp3 */, 611EE973122A9C4100DF6938 /* clickSound.caf */, 611EE9D7122AA10A00DF6938 /* backSound.caf */, 611EE9D8122AA10A00DF6938 /* selSound.caf */, @@ -967,7 +970,7 @@ 61A19AE414D2010A004B1E6D /* Products */ = { isa = PBXGroup; children = ( - 61A19AEA14D2010A004B1E6D /* libSDL.a */, + 61A19AEA14D2010A004B1E6D /* libSDL2.a */, 61A19AEC14D2010A004B1E6D /* testsdl.app */, ); name = Products; @@ -1315,10 +1318,10 @@ remoteRef = 619599431364C82B00B429B6 /* PBXContainerItemProxy */; sourceTree = BUILT_PRODUCTS_DIR; }; - 61A19AEA14D2010A004B1E6D /* libSDL.a */ = { + 61A19AEA14D2010A004B1E6D /* libSDL2.a */ = { isa = PBXReferenceProxy; fileType = archive.ar; - path = libSDL.a; + path = libSDL2.a; remoteRef = 61A19AE914D2010A004B1E6D /* PBXContainerItemProxy */; sourceTree = BUILT_PRODUCTS_DIR; }; @@ -1455,6 +1458,7 @@ 61156521147F48B6006729A9 /* About.strings in Resources */, 61156523147F48B7006729A9 /* Localizable.strings in Resources */, 61156525147F48B8006729A9 /* Scheme.strings in Resources */, + 616065A8159A71FD00CFAEF4 /* hwclassic.mp3 in Resources */, ); runOnlyForDeploymentPostprocessing = 0; }; @@ -1472,7 +1476,7 @@ ); runOnlyForDeploymentPostprocessing = 0; shellPath = /bin/sh; - shellScript = "#copy new stuff over old stuff\nrm -rf ${PROJECT_DIR}/Data\n\n#create config.inc\necho \"Updating config file...\"\nPROTO=`cat ${PROJECT_DIR}/../../CMakeLists.txt | grep HEDGEWARS_PROTO_VER | cut -d ' ' -f 2 | cut -d ')' -f 1`\nMAJN=`cat ${PROJECT_DIR}/../../CMakeLists.txt | grep CPACK_PACKAGE_VERSION_MAJOR | xargs | cut -d ' ' -f 2 |cut -d ')' -f 1`\nMINN=`cat ${PROJECT_DIR}/../../CMakeLists.txt | grep CPACK_PACKAGE_VERSION_MINOR | xargs | cut -d ' ' -f 2 |cut -d ')' -f 1`\nPATN=`cat ${PROJECT_DIR}/../../CMakeLists.txt | grep CPACK_PACKAGE_VERSION_PATCH | xargs | cut -d ' ' -f 2 |cut -d '$' -f 1`\nREVN=-`/usr/local/bin/hg id -n ${PROJECT_DIR}/../../`\necho \"const cNetProtoVersion = $PROTO; const cVersionString = '${MAJN}.${MINN}.${PATN}${REVN}'; const cLuaLibrary = '';\" > ${PROJECT_DIR}/config.inc\n\necho \"Copying Data...\"\ncp -R ${PROJECT_DIR}/../../share/hedgewars/Data ${PROJECT_DIR}/Data\n\n#copy some files from QTfrontend/res\necho \"Fetching additional graphics from QTfrontend...\"\nmkdir ${PROJECT_DIR}/Data/Graphics/Icons\ncp ${PROJECT_DIR}/../../QTfrontend/res/{btn*,icon*,StatsMedal*,ammopic*}.png ${PROJECT_DIR}/Data/Graphics/Icons/\n\necho \"Removing text and dummy files...\"\n#delete all CMakeLists.txt and image source files\nfind ${PROJECT_DIR}/Data -name CMakeLists.txt -delete\nfind ${PROJECT_DIR}/Data -name *.svg* -delete\nfind ${PROJECT_DIR}/Data -name *.psd -delete\nfind ${PROJECT_DIR}/Data -name *.sifz -delete\nfind ${PROJECT_DIR}/Data -name *.xcf -delete\nfind ${PROJECT_DIR}/Data -name *.orig -delete\nfind ${PROJECT_DIR}/Data -name *.ts -delete\n\n#delete dummy maps and hats, misc stuff\nrm -rf ${PROJECT_DIR}/Data/Maps/test*\nrm -rf ${PROJECT_DIR}/Data/Graphics/Hats/{TeamCap,TeamHeadband,TeamHair}\nrm -rf ${PROJECT_DIR}/Data/misc/\n\n#delete forbidden maps and WIP themes (remember to check that no Map uses them)\nrm -rf ${PROJECT_DIR}/Data/Maps/{Cheese,FlightJoust}\nrm -rf ${PROJECT_DIR}/Data/Themes/{Beach,Digital}\n\n#delete all names, reserved hats and unused fonts\nrm -rf ${PROJECT_DIR}/Data/Names/\nrm -rf ${PROJECT_DIR}/Data/Graphics/Hats/Reserved/\nrm -rf ${PROJECT_DIR}/Data/Fonts/{wqy-zenhei.ttc,DroidSansFallback.ttf}\n\necho \"Handling audio files...\"\n#copy mono audio\ncp -R ${PROJECT_DIR}/../AudioMono/* ${PROJECT_DIR}/Data/\n#delete the Classic voice\nrm -rf ${PROJECT_DIR}/Data/Sounds/voices/Classic\n#delete the main theme file\nrm -rf ${PROJECT_DIR}/Data/Music/main_theme.ogg\n\n#remove unused voices\nfor i in {Amazing,Brilliant,Bugger,Bungee,Cutitout,Drat,Excellent,Fire,FlawlessPossibility,Gonnagetyou,Grenade,Hmm,Justyouwait,Leavemealone,Ohdear,Ouch,Perfect,Revenge,Runaway,Solong,Thisoneismine,VictoryPossibility,Watchthis,Whatthe,Whoopsee}; do find Data/Sounds/voices/ -name $i.ogg -delete; done\n\necho \"Tweaking Data contents...\"\n#move Lua maps in Missions\nmkdir ${PROJECT_DIR}/Data/Missions/Maps/\nfor i in `ls ${PROJECT_DIR}/Data/Maps/`;\ndo \n if [[ `ls -f ${PROJECT_DIR}/Data/Maps/$i/map.lua 2> /dev/null` != '' ]];\n then\n mv ${PROJECT_DIR}/Data/Maps/$i ${PROJECT_DIR}/Data/Missions/Maps/;\n fi;\ndone;\n\n#workaround for missing map in CTF_Blizzard\nln -s ../../../Maps/Blizzard/map.png ${PROJECT_DIR}/Data/Missions/Maps/CTF_Blizzard/map.png\n\n#reduce the number of flakes for City\nsed -i -e 's/1500/50/' ${PROJECT_DIR}/Data/Themes/City/theme.cfg\n\necho \"Done\""; + shellScript = "SOURCE_DIR=${PROJECT_DIR}/../../\n\n#copy new stuff over old stuff\nrm -rf ${PROJECT_DIR}/Data\n\n#create config.inc\necho \"Updating config file...\"\nPROTO=`cat ${SOURCE_DIR}/CMakeLists.txt | grep HEDGEWARS_PROTO_VER | cut -d ' ' -f 2 | cut -d ')' -f 1`\nMAJN=`cat ${SOURCE_DIR}/CMakeLists.txt | grep CPACK_PACKAGE_VERSION_MAJOR | xargs | cut -d ' ' -f 2 |cut -d ')' -f 1`\nMINN=`cat ${SOURCE_DIR}/CMakeLists.txt | grep CPACK_PACKAGE_VERSION_MINOR | xargs | cut -d ' ' -f 2 |cut -d ')' -f 1`\nPATN=`cat ${SOURCE_DIR}/CMakeLists.txt | grep CPACK_PACKAGE_VERSION_PATCH | xargs | cut -d ' ' -f 2 |cut -d '$' -f 1`\nREVN=-`/usr/local/bin/hg id -n ${SOURCE_DIR}`\necho \"const cNetProtoVersion = $PROTO; const cVersionString = '${MAJN}.${MINN}.${PATN}${REVN}'; const cLuaLibrary = '';\" > ${PROJECT_DIR}/config.inc\n\necho \"Copying Data...\"\ncp -R ${SOURCE_DIR}/share/hedgewars/Data ${PROJECT_DIR}/Data\n\n#copy some other files\necho \"Fetching additional graphics...\"\nmkdir -p ${PROJECT_DIR}/Data/Graphics/Icons\ncp ${SOURCE_DIR}/QTfrontend/res/{btn*,icon*,StatsMedal*,ammopic*}.png ${PROJECT_DIR}/Data/Graphics/Icons/\ncp -R ${SOURCE_DIR}/project_files/Android-build/SDL-android-project/assets/Data/Graphics/Buttons ${PROJECT_DIR}/Data/Graphics/\n\necho \"Removing text and dummy files...\"\n#delete all CMakeLists.txt and image source files\nfind ${PROJECT_DIR}/Data -name CMakeLists.txt -delete\nfind ${PROJECT_DIR}/Data -name *.svg* -delete\nfind ${PROJECT_DIR}/Data -name *.psd -delete\nfind ${PROJECT_DIR}/Data -name *.sifz -delete\nfind ${PROJECT_DIR}/Data -name *.xcf -delete\nfind ${PROJECT_DIR}/Data -name *.orig -delete\nfind ${PROJECT_DIR}/Data -name *.ts -delete\n\n#delete dummy maps and hats, misc stuff\nrm -rf ${PROJECT_DIR}/Data/Maps/test*\nrm -rf ${PROJECT_DIR}/Data/Graphics/Hats/{TeamCap,TeamHeadband,TeamHair}\nrm -rf ${PROJECT_DIR}/Data/misc/\n\n#delete forbidden maps and WIP themes (remember to check that no Map uses them)\nrm -rf ${PROJECT_DIR}/Data/Maps/{Cheese,FlightJoust}\nrm -rf ${PROJECT_DIR}/Data/Themes/{Beach,Digital}\n\n#delete all names, reserved hats and unused fonts\nrm -rf ${PROJECT_DIR}/Data/Names/\nrm -rf ${PROJECT_DIR}/Data/Graphics/Hats/Reserved/\nrm -rf ${PROJECT_DIR}/Data/Fonts/{wqy-zenhei.ttc,DroidSansFallback.ttf}\n\necho \"Handling audio files...\"\n#copy mono audio\ncp -R ${SOURCE_DIR}/project_files/AudioMono/* ${PROJECT_DIR}/Data/\n#delete the Classic voice\nrm -rf ${PROJECT_DIR}/Data/Sounds/voices/Classic\n#delete the main theme file\nrm -rf ${PROJECT_DIR}/Data/Music/main_theme.ogg\n\n#remove unused voices\nfor i in {Amazing,Brilliant,Bugger,Bungee,Cutitout,Drat,Excellent,Fire,FlawlessPossibility,Gonnagetyou,Grenade,Hmm,Justyouwait,Leavemealone,Ohdear,Ouch,Perfect,Revenge,Runaway,Solong,Thisoneismine,VictoryPossibility,Watchthis,Whatthe,Whoopsee}; do find Data/Sounds/voices/ -name $i.ogg -delete; done\n\necho \"Tweaking Data contents...\"\n#move Lua maps in Missions\nmkdir ${PROJECT_DIR}/Data/Missions/Maps/\nfor i in `ls ${PROJECT_DIR}/Data/Maps/`;\ndo \n if [[ `ls -f ${PROJECT_DIR}/Data/Maps/$i/map.lua 2> /dev/null` != '' ]];\n then\n mv ${PROJECT_DIR}/Data/Maps/$i ${PROJECT_DIR}/Data/Missions/Maps/;\n fi;\ndone;\n\n#workaround for missing map in CTF_Blizzard\nln -s ../../../Maps/Blizzard/map.png ${PROJECT_DIR}/Data/Missions/Maps/CTF_Blizzard/map.png\n\n#reduce the number of flakes for City\nsed -i -e 's/1500/50/' ${PROJECT_DIR}/Data/Themes/City/theme.cfg\n\necho \"Done\""; showEnvVarsInLog = 0; }; 9283011B0F10CB2D00CC5A3C /* Build libfpc.a */ = { @@ -1756,7 +1760,6 @@ GCC_WARN_UNUSED_VALUE = YES; GCC_WARN_UNUSED_VARIABLE = YES; HEADER_SEARCH_PATHS = ( - "\"$(SRCROOT)/../../../Library/SDL/src/video\"/**", "\"$(SRCROOT)/../../../Library/SDL/include/\"", "\"$(SRCROOT)/../../../Library/SDL_net/\"", "\"$(SRCROOT)/../../../Library/SDL_mixer/\"", @@ -1862,7 +1865,6 @@ GCC_WARN_UNUSED_VALUE = YES; GCC_WARN_UNUSED_VARIABLE = YES; HEADER_SEARCH_PATHS = ( - "\"$(SRCROOT)/../../../Library/SDL/src/video\"/**", "\"$(SRCROOT)/../../../Library/SDL/include/\"", "\"$(SRCROOT)/../../../Library/SDL_net/\"", "\"$(SRCROOT)/../../../Library/SDL_mixer/\"", @@ -2010,7 +2012,6 @@ GCC_WARN_UNUSED_VALUE = YES; GCC_WARN_UNUSED_VARIABLE = YES; HEADER_SEARCH_PATHS = ( - "\"$(SRCROOT)/../../../Library/SDL/src/video\"/**", "\"$(SRCROOT)/../../../Library/SDL/include/\"", "\"$(SRCROOT)/../../../Library/SDL_net/\"", "\"$(SRCROOT)/../../../Library/SDL_mixer/\"", @@ -2080,7 +2081,6 @@ GCC_WARN_UNUSED_VALUE = YES; GCC_WARN_UNUSED_VARIABLE = YES; HEADER_SEARCH_PATHS = ( - "\"$(SRCROOT)/../../../Library/SDL/src/video\"/**", "\"$(SRCROOT)/../../../Library/SDL/include/\"", "\"$(SRCROOT)/../../../Library/SDL_net/\"", "\"$(SRCROOT)/../../../Library/SDL_mixer/\"", diff -r 3cff5c769509 -r 88685fbb2679 share/hedgewars/Data/Graphics/hedgewars.svg --- a/share/hedgewars/Data/Graphics/hedgewars.svg Tue Jun 26 23:29:41 2012 +0400 +++ b/share/hedgewars/Data/Graphics/hedgewars.svg Fri Jul 06 12:50:18 2012 +0400 @@ -10,26 +10,75 @@ xmlns:xlink="http://www.w3.org/1999/xlink" xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd" xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape" - id="svg2" + width="2001.415" + height="373.84308" + id="svg3761" version="1.1" inkscape:version="0.48.3.1 r9886" - width="2001.4674" - height="374.02328" - sodipodi:docname="temp.svg"> - - - - image/svg+xml - - - - - + sodipodi:docname="hedgewars.svg"> + id="defs3763"> + + + + + + + + + + + + + + + + + @@ -56,56 +105,135 @@ offset="1" id="stop4196" /> + + + + + - - - - - + fit-margin-bottom="0" + inkscape:window-width="1896" + inkscape:window-height="1026" + inkscape:window-x="24" + inkscape:window-y="0" + inkscape:window-maximized="1" + showguides="true" + inkscape:guide-bbox="true"> + + + + + + image/svg+xml + + + + + + + + + + + + diff -r 3cff5c769509 -r 88685fbb2679 share/hedgewars/Data/Locale/missions_fr.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/share/hedgewars/Data/Locale/missions_fr.txt Fri Jul 06 12:50:18 2012 +0400 @@ -0,0 +1,47 @@ +Basic_Training_-_Bazooka.name=Initiation au Bazooka +Basic_Training_-_Bazooka.desc="Pour gagner, utiliser le vent à votre avantage !" + +Basic_Training_-_Grenade.name=Entrainement au lancer de Grenade +Basic_Training_-_Grenade.desc="Souvenez vous, retirez la goupille et lancez !" + +Basic_Training_-_Cluster_Bomb.name=Entrainement au lancer de grenade à fragmentation +Basic_Training_-_Cluster_Bomb.desc="Quelqu'un à besoin d'une bonne douche !" + +Basic_Training_-_Shotgun.name=Initiation au Fusil +Basic_Training_-_Shotgun.desc="On tire d'abord, on pose les questions après !" + +Basic_Training_-_Sniper_Rifle.name=Initiation au Sniper +Basic_Training_-_Sniper_Rifle.desc="Pan ! En pleine tête !" + +Basic_Training_-_Rope.name=Initiation à la Corde Ninja +Basic_Training_-_Rope.desc="Bouge de là et Balance toi !" + +User_Mission_-_Dangerous_Ducklings.name=Mission: Canards dangereux +User_Mission_-_Dangerous_Ducklings.desc="Très bien le bleu, il est temps de mettre en pratique ce que tu as appris aux entraînements !" + +User_Mission_-_Diver.name=Mission: Diver +User_Mission_-_Diver.desc="Cet assault 'sous-marin' est plus dur que cela n'y paraît...." + +User_Mission_-_Teamwork.name=Mission: Travail en équipe +User_Mission_-_Teamwork.desc="Parfois, l'amour blesse." + +User_Mission_-_Spooky_Tree.name=Mission: L'arbre qui parle +User_Mission_-_Spooky_Tree.desc="Beaucoup de caisses par ici. J'espère vraiment que cet oiseau n'a pas faim." + +User_Mission_-_Bamboo_Thicket.name=Mission: Forêt de Bamboo +User_Mission_-_Bamboo_Thicket.desc="La mort vient d'en haut." + +User_Mission_-_That_Sinking_Feeling.name=Mission: Cette impression de naufrage +User_Mission_-_That_Sinking_Feeling.desc="L'eau monte rapidement et le temps est compté. Beaucoup ont essayé, sans succès.Pouvez vous tous les sauvez ?" + +User_Mission_-_Newton_and_the_Hammock.name=Mission: Newton et le Hammac +User_Mission_-_Newton_and_the_Hammock.desc="Souvenez vous petits hérissons : La vitesse d'un corps reste constante à moins que ce corps ne soit attiré par une force extérieure!" + +User_Mission_-_The_Great_Escape.name=Mission: La grande évasion +User_Mission_-_The_Great_Escape.desc="Tu pense que tu peux me capturer ?!" + +User_Mission_-_Rope_Knock_Challenge.name=Challenge: A coup de Corde Ninja +User_Mission_-_Rope_Knock_Challenge.desc="Regarde derrière toi !" + +User_Mission_-_RCPlane_Challenge.name=Challenge: Avion télécommandé +User_Mission_-_RCPlane_Challenge.desc="Plutôt confiant, hein, aviateur ?" \ No newline at end of file diff -r 3cff5c769509 -r 88685fbb2679 tools/PascalBasics.hs --- a/tools/PascalBasics.hs Tue Jun 26 23:29:41 2012 +0400 +++ b/tools/PascalBasics.hs Fri Jul 06 12:50:18 2012 +0400 @@ -9,7 +9,7 @@ import Data.Char builtin = ["succ", "pred", "low", "high", "ord", "inc", "dec", "exit", "break", "continue", "length"] - + pascalLanguageDef = emptyDef { commentStart = "(*" @@ -27,8 +27,8 @@ , "downto", "div", "mod", "record", "set", "nil" , "cdecl", "external", "if", "then", "else" ] -- ++ builtin - , reservedOpNames= [] - , caseSensitive = False + , reservedOpNames= [] + , caseSensitive = False } preprocessorSwitch :: Stream s m Char => ParsecT s u m String @@ -36,11 +36,11 @@ try $ string "{$" s <- manyTill (noneOf "\n") $ char '}' return s - + caseInsensitiveString s = do mapM_ (\a -> satisfy (\b -> toUpper a == toUpper b)) s s return s - + pas = patch $ makeTokenParser pascalLanguageDef where patch tp = tp {stringLiteral = stringL} @@ -50,7 +50,7 @@ , (try $ string "(*") >> manyTill anyChar (try $ string "*)") , (try $ string "//") >> manyTill anyChar (try newline) ] - + comments = do spaces skipMany $ do @@ -66,5 +66,5 @@ s' <- (many $ noneOf "'") (char '\'') return $ '\'' : s' - comments + comments return $ concat (s:ss) diff -r 3cff5c769509 -r 88685fbb2679 tools/PascalParser.hs --- a/tools/PascalParser.hs Tue Jun 26 23:29:41 2012 +0400 +++ b/tools/PascalParser.hs Fri Jul 06 12:50:18 2012 +0400 @@ -14,7 +14,7 @@ import PascalBasics import PascalUnitSyntaxTree - + knownTypes = ["shortstring", "ansistring", "char", "byte"] pascalUnit = do @@ -27,7 +27,7 @@ i <- liftM (flip Identifier BTUnknown) (identifier pas) comments return i - + unit = do string "unit" >> comments name <- iD @@ -38,7 +38,7 @@ comments return $ Unit name int impl Nothing Nothing - + reference = buildExpressionParser table term "reference" where term = comments >> choice [ @@ -48,9 +48,9 @@ , liftM SimpleReference iD >>= postfixes ] "simple reference" - table = [ + table = [ ] - + postfixes r = many postfix >>= return . foldl (flip ($)) r postfix = choice [ parens pas (option [] parameters) >>= return . FunCall @@ -64,21 +64,23 @@ e <- parens pas expression comments return $ TypeCast (Identifier t BTUnknown) e - - -varsDecl1 = varsParser sepEndBy1 + +varsDecl1 = varsParser sepEndBy1 varsDecl = varsParser sepEndBy varsParser m endsWithSemi = do vs <- m (aVarDecl endsWithSemi) (semi pas) return vs aVarDecl endsWithSemi = do - unless endsWithSemi $ - optional $ choice [ - try $ string "var" - , try $ string "const" - , try $ string "out" - ] + isVar <- liftM (== Just "var") $ + if not endsWithSemi then + optionMaybe $ choice [ + try $ string "var" + , try $ string "const" + , try $ string "out" + ] + else + return Nothing comments ids <- do i <- (commaSep1 pas) $ (try iD "variable declaration") @@ -93,7 +95,7 @@ e <- initExpression comments return (Just e) - return $ VarDeclaration False (ids, t) init + return $ VarDeclaration isVar False (ids, t) init constsDecl = do @@ -114,8 +116,8 @@ comments e <- initExpression comments - return $ VarDeclaration (isNothing t) ([i], fromMaybe (DeriveType e) t) (Just e) - + return $ VarDeclaration False (isNothing t) ([i], fromMaybe (DeriveType e) t) (Just e) + typeDecl = choice [ char '^' >> typeDecl >>= return . PointerTo , try (string "shortstring") >> return (String 255) @@ -211,7 +213,6 @@ comments return $ TypeDeclaration i t - rangeDecl = choice [ try $ rangeft , iD >>= return . Range @@ -221,8 +222,8 @@ e1 <- initExpression string ".." e2 <- initExpression - return $ RangeFromTo e1 e2 - + return $ RangeFromTo e1 e2 + typeVarDeclaration isImpl = (liftM concat . many . choice) [ varSection, constSection, @@ -251,7 +252,7 @@ t <- typesDecl "type declaration" comments return t - + operatorDecl = do try $ string "operator" comments @@ -276,7 +277,7 @@ return Nothing return $ [OperatorDeclaration i rid ret vs b] - + funcDecl = do fp <- try (string "function") <|> try (string "procedure") comments @@ -300,7 +301,7 @@ else return Nothing return $ [FunctionDeclaration i ret vs b] - + functionDecorator = choice [ try $ string "inline;" , try $ caseInsensitiveString "cdecl;" @@ -309,8 +310,8 @@ , try $ string "varargs;" , try (string "external") >> comments >> iD >> optional (string "name" >> comments >> stringLiteral pas)>> string ";" ] >> comments - - + + program = do string "program" comments @@ -396,15 +397,15 @@ ] ] strOrChar [a] = CharCode . show . ord $ a - strOrChar a = StringLiteral a - + strOrChar a = StringLiteral a + phrasesBlock = do try $ string "begin" comments p <- manyTill phrase (try $ string "end" >> notFollowedBy alphaNum) comments return $ Phrases p - + phrase = do o <- choice [ phrasesBlock @@ -459,7 +460,7 @@ comments o <- phrase return $ foldr WithBlock o rs - + repeatCycle = do try $ string "repeat" >> space comments @@ -488,7 +489,7 @@ p <- phrase comments return $ ForCycle i e1 e2 p - + switchCase = do try $ string "case" comments @@ -515,14 +516,14 @@ p <- phrase comments return (e, p) - + procCall = do r <- reference p <- option [] $ (parens pas) parameters return $ ProcCall r p parameters = (commaSep pas) expression "parameters" - + functionBody = do tv <- typeVarDeclaration True comments @@ -559,7 +560,7 @@ , itypeCast , iD >>= return . InitReference ] - + recField = do i <- iD spaces @@ -569,7 +570,7 @@ spaces return (i ,e) - table = [ + table = [ [ Prefix (char '-' >> return (InitPrefixOp "-")) ] @@ -603,7 +604,7 @@ i <- parens pas initExpression comments return $ InitTypeCast (Identifier t BTUnknown) i - + builtInFunction e = do name <- choice $ map (\s -> try $ caseInsensitiveString s >>= \i -> notFollowedBy alphaNum >> return i) builtin spaces diff -r 3cff5c769509 -r 88685fbb2679 tools/PascalPreprocessor.hs --- a/tools/PascalPreprocessor.hs Tue Jun 26 23:29:41 2012 +0400 +++ b/tools/PascalPreprocessor.hs Fri Jul 06 12:50:18 2012 +0400 @@ -19,7 +19,7 @@ ("FPC", "") , ("PAS2C", "") ] - + preprocess :: String -> IO String preprocess fn = do r <- runParserT (preprocessFile fn) (initDefines, [True]) "" "" @@ -28,17 +28,17 @@ hPutStrLn stderr (show a) return "" (Right a) -> return a - + where preprocessFile fn = do f <- liftIO (readFile fn) setInput f preprocessor - + preprocessor, codeBlock, switch :: ParsecT String (Map.Map String String, [Bool]) IO String - + preprocessor = chainr codeBlock (return (++)) "" - + codeBlock = do s <- choice [ switch @@ -55,7 +55,7 @@ c <- letter <|> oneOf "_" s <- many (alphaNum <|> oneOf "_") return $ c:s - + switch = do try $ string "{$" s <- choice [ @@ -68,7 +68,7 @@ , unknown ] return s - + include = do try $ string "INCLUDE" spaces @@ -85,26 +85,26 @@ ifdef = do s <- try (string "IFDEF") <|> try (string "IFNDEF") let f = if s == "IFNDEF" then not else id - + spaces d <- identifier spaces char '}' - + updateState $ \(m, b) -> (m, (f $ d `Map.member` m) : b) - + return "" if' = do s <- try (string "IF" >> notFollowedBy alphaNum) - + manyTill anyChar (char '}') --char '}' - + updateState $ \(m, b) -> (m, False : b) - + return "" elseSwitch = do @@ -118,7 +118,7 @@ define = do try $ string "DEFINE" spaces - i <- identifier + i <- identifier d <- ((string ":=" >> return ())<|> spaces) >> many (noneOf "}") char '}' updateState $ \(m, b) -> (if (and b) && (head i /= '_') then Map.insert i d m else m, b) @@ -126,7 +126,7 @@ replace s = do (m, _) <- getState return $ Map.findWithDefault s s m - + unknown = do fn <- many1 $ noneOf "}\n" char '}' diff -r 3cff5c769509 -r 88685fbb2679 tools/PascalUnitSyntaxTree.hs --- a/tools/PascalUnitSyntaxTree.hs Tue Jun 26 23:29:41 2012 +0400 +++ b/tools/PascalUnitSyntaxTree.hs Fri Jul 06 12:50:18 2012 +0400 @@ -17,7 +17,7 @@ data TypesAndVars = TypesAndVars [TypeVarDeclaration] deriving Show data TypeVarDeclaration = TypeDeclaration Identifier TypeDecl - | VarDeclaration Bool ([Identifier], TypeDecl) (Maybe InitExpression) + | VarDeclaration Bool Bool ([Identifier], TypeDecl) (Maybe InitExpression) | FunctionDeclaration Identifier TypeDecl [TypeVarDeclaration] (Maybe (TypesAndVars, Phrase)) | OperatorDeclaration String Identifier TypeDecl [TypeVarDeclaration] (Maybe (TypesAndVars, Phrase)) deriving Show @@ -30,8 +30,9 @@ | String Integer | Set TypeDecl | FunctionType TypeDecl [TypeVarDeclaration] - | DeriveType InitExpression + | DeriveType InitExpression | VoidType + | VarParamType TypeDecl -- this is a hack deriving Show data Range = Range Identifier | RangeFromTo InitExpression InitExpression @@ -106,11 +107,12 @@ | BTFloat | BTRecord String [(String, BaseType)] | BTArray Range BaseType BaseType - | BTFunction Int BaseType + | BTFunction Bool Int BaseType | BTPointerTo BaseType | BTUnresolved String | BTSet BaseType | BTEnum [String] | BTVoid | BTUnit + | BTVarParam BaseType deriving Show diff -r 3cff5c769509 -r 88685fbb2679 tools/pas2c.hs --- a/tools/pas2c.hs Tue Jun 26 23:29:41 2012 +0400 +++ b/tools/pas2c.hs Fri Jul 06 12:50:18 2012 +0400 @@ -21,7 +21,7 @@ import PascalUnitSyntaxTree -data InsertOption = +data InsertOption = IOInsert | IOLookup | IOLookupLast @@ -30,7 +30,7 @@ type Record = (String, BaseType) type Records = Map.Map String [Record] -data RenderState = RenderState +data RenderState = RenderState { currentScope :: Records, lastIdentifier :: String, @@ -42,7 +42,7 @@ currentFunctionResult :: String, namespaces :: Map.Map String Records } - + emptyState = RenderState Map.empty "" BTUnknown [] 0 Set.empty "" "" getUniq :: State RenderState Int @@ -50,7 +50,7 @@ i <- gets uniqCounter modify(\s -> s{uniqCounter = uniqCounter s + 1}) return i - + addStringConst :: String -> State RenderState Doc addStringConst str = do strs <- gets stringConsts @@ -65,7 +65,7 @@ let sn = "__str" ++ show i modify (\s -> s{lastType = BTString, stringConsts = (sn, str) : strs}) return $ text sn - + escapeStr :: String -> String escapeStr = foldr escapeChar [] @@ -77,9 +77,9 @@ strInit a = text "STRINIT" <> parens (doubleQuotes (text $ escapeStr a)) renderStringConsts :: State RenderState Doc -renderStringConsts = liftM (vcat . map (\(a, b) -> text "const string255" <+> (text a) <+> text "=" <+> strInit b <> semi)) +renderStringConsts = liftM (vcat . map (\(a, b) -> text "const string255" <+> (text a) <+> text "=" <+> strInit b <> semi)) $ gets stringConsts - + docToLower :: Doc -> Doc docToLower = text . map toLower . render @@ -97,8 +97,8 @@ processed <- gets $ Map.member fileName unless processed $ do print ("Preprocessing '" ++ fileName ++ ".pas'... ") - fc' <- liftIO - $ tryJust (guard . isDoesNotExistError) + fc' <- liftIO + $ tryJust (guard . isDoesNotExistError) $ preprocess (fileName ++ ".pas") case fc' of (Left a) -> do @@ -127,14 +127,14 @@ mapM_ (toCFiles nss) u where toNamespace :: Map.Map String Records -> PascalUnit -> Records - toNamespace nss (System tvs) = + toNamespace nss (System tvs) = currentScope $ execState f (emptyState nss) where f = do checkDuplicateFunDecls tvs - mapM_ (tvar2C True) tvs + mapM_ (tvar2C True) tvs toNamespace _ (Program {}) = Map.empty - toNamespace nss (Unit (Identifier i _) interface _ _ _) = + toNamespace nss (Unit (Identifier i _) interface _ _ _) = currentScope $ execState (interface2C interface) (emptyState nss){currentUnit = map toLower i ++ "_"} @@ -188,22 +188,22 @@ pascal2C :: PascalUnit -> State RenderState Doc pascal2C (Unit _ interface implementation init fin) = liftM2 ($+$) (interface2C interface) (implementation2C implementation) - + pascal2C (Program _ implementation mainFunction) = do impl <- implementation2C implementation - [main] <- tvar2C True + [main] <- tvar2C True (FunctionDeclaration (Identifier "main" BTInt) (SimpleType $ Identifier "int" BTInt) [] (Just (TypesAndVars [], mainFunction))) return $ impl $+$ main - - + + interface2C :: Interface -> State RenderState Doc interface2C (Interface uses tvars) = do u <- uses2C uses tv <- typesAndVars2C True tvars r <- renderStringConsts return (u $+$ r $+$ tv) - + implementation2C :: Implementation -> State RenderState Doc implementation2C (Implementation uses tvars) = do u <- uses2C uses @@ -247,11 +247,12 @@ ns <- gets currentScope tom <- gets (Set.member n . toMangle) cu <- gets currentUnit - let i' = case (t, tom) of - (BTFunction p _, True) -> cu ++ i ++ ('_' : show p) - (BTFunction _ _, _) -> cu ++ i - _ -> i - modify (\s -> s{currentScope = Map.insertWith (++) n [(i', t)] (currentScope s), lastIdentifier = n}) + let (i', t') = case (t, tom) of + (BTFunction _ p _, True) -> (cu ++ i ++ ('_' : show p), t) + (BTFunction _ _ _, _) -> (cu ++ i, t) + (BTVarParam t', _) -> ('(' : '*' : i ++ ")" , t') + _ -> (i, t) + modify (\s -> s{currentScope = Map.insertWith (++) n [(i', t')] (currentScope s), lastIdentifier = n}) return $ text i' where n = map toLower i @@ -261,13 +262,13 @@ let i' = map toLower i v <- gets $ Map.lookup i' . currentScope lt <- gets lastType - if isNothing v then + if isNothing v then error $ "Not defined: '" ++ i' ++ "'\n" ++ show lt ++ "\nwith num of params = " ++ show params ++ "\n" ++ show v - else - let vv = fromMaybe (head $ fromJust v) . find checkParam $ fromJust v in + else + let vv = fromMaybe (head $ fromJust v) . find checkParam $ fromJust v in modify (\s -> s{lastType = snd vv, lastIdentifier = fst vv}) >> (return . text . fst $ vv) where - checkParam (_, BTFunction p _) = p == params + checkParam (_, BTFunction _ p _) = p == params checkParam _ = False id2C IODeferred (Identifier i t) = do let i' = map toLower i @@ -282,16 +283,16 @@ let i' = map toLower i v <- gets $ Map.lookup i' . currentScope lt <- gets lastType - if isNothing v then + if isNothing v then error $ "Not defined: '" ++ i' ++ "'\n" ++ show lt - else + else let vv = f $ fromJust v in modify (\s -> s{lastType = snd vv, lastIdentifier = fst vv}) >> (return . text . fst $ vv) - - + + id2CTyped :: TypeDecl -> Identifier -> State RenderState Doc id2CTyped t (Identifier i _) = do tb <- resolveType t - case (t, tb) of + case (t, tb) of (_, BTUnknown) -> do error $ "id2CTyped: type BTUnknown for " ++ show i ++ "\ntype: " ++ show t (SimpleType {}, BTRecord _ r) -> do @@ -301,7 +302,7 @@ ts <- type2C t id2C IOInsert (Identifier i (BTRecord i r)) _ -> id2C IOInsert (Identifier i tb) - + resolveType :: TypeDecl -> State RenderState BaseType @@ -324,12 +325,12 @@ return . BTRecord "" . concat $ tvs where f :: TypeVarDeclaration -> State RenderState [(String, BaseType)] - f (VarDeclaration _ (ids, td) _) = mapM (\(Identifier i _) -> liftM ((,) i) $ resolveType td) ids + f (VarDeclaration _ _ (ids, td) _) = mapM (\(Identifier i _) -> liftM ((,) i) $ resolveType td) ids resolveType (ArrayDecl (Just i) t) = do t' <- resolveType t - return $ BTArray i BTInt t' + return $ BTArray i BTInt t' resolveType (ArrayDecl Nothing t) = liftM (BTArray RangeInfinite BTInt) $ resolveType t -resolveType (FunctionType t a) = liftM (BTFunction (length a)) $ resolveType t +resolveType (FunctionType t a) = liftM (BTFunction False (length a)) $ resolveType t resolveType (DeriveType (InitHexNumber _)) = return BTInt resolveType (DeriveType (InitNumber _)) = return BTInt resolveType (DeriveType (InitFloat _)) = return BTFloat @@ -344,7 +345,8 @@ resolveType (Sequence ids) = return $ BTEnum $ map (\(Identifier i _) -> map toLower i) ids resolveType (RangeType _) = return $ BTVoid resolveType (Set t) = liftM BTSet $ resolveType t - +resolveType (VarParamType t) = liftM BTVarParam $ resolveType t + resolve :: String -> BaseType -> State RenderState BaseType resolve s (BTUnresolved t) = do @@ -360,46 +362,75 @@ fromPointer s t = do error $ "Dereferencing from non-pointer type " ++ show t ++ "\n" ++ s - + functionParams2C params = liftM (hcat . punctuate comma . concat) $ mapM (tvar2C False) params numberOfDeclarations :: [TypeVarDeclaration] -> Int numberOfDeclarations = sum . map cnt where - cnt (VarDeclaration _ (ids, _) _) = length ids + cnt (VarDeclaration _ _ (ids, _) _) = length ids cnt _ = 1 +hasPassByReference :: [TypeVarDeclaration] -> Bool +hasPassByReference = or . map isVar + where + isVar (VarDeclaration v _ (_, _) _) = v + isVar _ = error $ "hasPassByReference called not on function parameters" + +toIsVarList :: [TypeVarDeclaration] -> [Bool] +toIsVarList = concatMap isVar + where + isVar (VarDeclaration v _ (p, _) _) = replicate (length p) v + isVar _ = error $ "toIsVarList called not on function parameters" + + +funWithVarsToDefine :: String -> [TypeVarDeclaration] -> Doc +funWithVarsToDefine n params = text "#define" <+> text n <> parens abc <+> text (n ++ "__vars") <> parens cparams + where + abc = hcat . punctuate comma . map (char . fst) $ ps + cparams = hcat . punctuate comma . map (\(c, v) -> if v then char '&' <> parens (char c) else char c) $ ps + ps = zip ['a'..] (toIsVarList params) + fun2C :: Bool -> String -> TypeVarDeclaration -> State RenderState [Doc] fun2C _ _ (FunctionDeclaration name returnType params Nothing) = do - t <- type2C returnType + t <- type2C returnType t'<- gets lastType p <- withState' id $ functionParams2C params - n <- id2C IOInsert $ setBaseType (BTFunction (numberOfDeclarations params) t') name - return [t empty <+> n <> parens p] - -fun2C True rv (FunctionDeclaration name returnType params (Just (tvars, phrase))) = do + n <- liftM render . id2C IOInsert $ setBaseType (BTFunction hasVars (numberOfDeclarations params) t') name + if hasVars then + return [funWithVarsToDefine n params $+$ t empty <+> text (n ++ "__vars") <> parens p] + else + return [t empty <+> text n <> parens p] + where + hasVars = hasPassByReference params + + +fun2C True rv (FunctionDeclaration name@(Identifier i _) returnType params (Just (tvars, phrase))) = do let res = docToLower $ text rv <> text "_result" t <- type2C returnType t'<- gets lastType - n <- id2C IOInsert $ setBaseType (BTFunction (numberOfDeclarations params) t') name - + + notDeclared <- liftM isNothing . gets $ Map.lookup (map toLower i) . currentScope + + n <- liftM render . id2C IOInsert $ setBaseType (BTFunction hasVars (numberOfDeclarations params) t') name + let isVoid = case returnType of VoidType -> True _ -> False - + (p, ph) <- withState' (\st -> st{currentScope = Map.insertWith un (map toLower rv) [(render res, t')] $ currentScope st , currentFunctionResult = if isVoid then [] else render res}) $ do p <- functionParams2C params ph <- liftM2 ($+$) (typesAndVars2C False tvars) (phrase2C' phrase) return (p, ph) - + let phrasesBlock = if isVoid then ph else t empty <+> res <> semi $+$ ph $+$ text "return" <+> res <> semi - - return [ - t empty <+> n <> parens p + + return [(if notDeclared && hasVars then funWithVarsToDefine n params else empty) $+$ + t empty <+> text (if hasVars then n ++ "__vars" else n) <> parens p $+$ - text "{" - $+$ + text "{" + $+$ nest 4 phrasesBlock $+$ text "}"] @@ -407,7 +438,8 @@ phrase2C' (Phrases p) = liftM vcat $ mapM phrase2C p phrase2C' p = phrase2C p un [a] b = a : b - + hasVars = hasPassByReference params + fun2C False _ (FunctionDeclaration (Identifier name _) _ _ _) = error $ "nested functions not allowed: " ++ name fun2C _ tv _ = error $ "fun2C: I don't render " ++ show tv @@ -418,8 +450,12 @@ i <- id2CTyped t i' tp <- type2C t return [text "typedef" <+> tp i] - -tvar2C _ (VarDeclaration isConst (ids, t) mInitExpr) = do + +tvar2C _ (VarDeclaration True _ (ids, t) Nothing) = do + t' <- liftM ((empty <+>) . ) $ type2C t + liftM (map(\i -> t' i)) $ mapM (id2CTyped (VarParamType t)) ids + +tvar2C _ (VarDeclaration _ isConst (ids, t) mInitExpr) = do t' <- liftM (((if isConst then text "const" else empty) <+>) . ) $ type2C t ie <- initExpr mInitExpr lt <- gets lastType @@ -431,23 +467,23 @@ i' <- id2CTyped t i ie <- initExpr2C e return [text "#define" <+> i' <+> parens ie <> text "\n"] - (_, BTFunction{}, _, Nothing) -> liftM (map(\i -> t' $ text "*" <+> i)) $ mapM (id2CTyped t) ids + (_, BTFunction{}, _, Nothing) -> liftM (map(\i -> t' i)) $ mapM (id2CTyped t) ids _ -> liftM (map(\i -> t' i <+> ie)) $ mapM (id2CTyped t) ids where initExpr Nothing = return $ empty initExpr (Just e) = liftM (text "=" <+>) (initExpr2C e) - + tvar2C f (OperatorDeclaration op (Identifier i _) ret params body) = do r <- op2CTyped op (extractTypes params) fun2C f i (FunctionDeclaration r ret params body) - + op2CTyped :: String -> [TypeDecl] -> State RenderState Identifier op2CTyped op t = do t' <- liftM (render . hcat . punctuate (char '_') . map (\t -> t empty)) $ mapM type2C t bt <- gets lastType return $ Identifier (t' ++ "_op_" ++ opStr) bt - where + where opStr = case op of "+" -> "add" "-" -> "sub" @@ -458,18 +494,23 @@ ">" -> "gt" "<>" -> "neq" _ -> error $ "op2CTyped: unknown op '" ++ op ++ "'" - + extractTypes :: [TypeVarDeclaration] -> [TypeDecl] extractTypes = concatMap f where - f (VarDeclaration _ (ids, t) _) = replicate (length ids) t + f (VarDeclaration _ _ (ids, t) _) = replicate (length ids) t f a = error $ "extractTypes: can't extract from " ++ show a initExpr2C, initExpr2C' :: InitExpression -> State RenderState Doc initExpr2C (InitArray values) = liftM (braces . vcat . punctuate comma) $ mapM initExpr2C values initExpr2C a = initExpr2C' a initExpr2C' InitNull = return $ text "NULL" -initExpr2C' (InitAddress expr) = liftM ((<>) (text "&")) (initExpr2C' expr) +initExpr2C' (InitAddress expr) = do + ie <- initExpr2C' expr + lt <- gets lastType + case lt of + BTFunction True _ _ -> return $ text "&" <> ie <> text "__vars" + _ -> return $ text "&" <> ie initExpr2C' (InitPrefixOp op expr) = liftM (text (op2C op) <>) (initExpr2C' expr) initExpr2C' (InitBinOp op expr1 expr2) = do e1 <- initExpr2C' expr1 @@ -500,7 +541,7 @@ initExpr2C' (InitRange a) = error $ show a --return $ text "<>" initExpr2C' (InitSet []) = return $ text "0" initExpr2C' (InitSet a) = return $ text "<>" -initExpr2C' (BuiltInFunction "low" [InitReference e]) = return $ +initExpr2C' (BuiltInFunction "low" [InitReference e]) = return $ case e of (Identifier "LongInt" _) -> int (-2^31) (Identifier "SmallInt" _) -> int (-2^15) @@ -515,7 +556,7 @@ 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 +initExpr2C' b@(BuiltInFunction _ _) = error $ show b initExpr2C' a = error $ "initExpr2C: don't know how to render " ++ show a @@ -582,7 +623,7 @@ type2C' (FunctionType returnType params) = do t <- type2C returnType p <- withState' id $ functionParams2C params - return (\i -> t empty <+> i <> parens p) + return (\i -> (t empty <> (parens $ text "*" <> i) <> parens p)) type2C' (DeriveType (InitBinOp _ _ i)) = type2C' (DeriveType i) type2C' (DeriveType (InitPrefixOp _ i)) = type2C' (DeriveType i) type2C' (DeriveType (InitNumber _)) = return (text "int" <+>) @@ -610,7 +651,7 @@ e <- expr2C expr p1 <- (phrase2C . wrapPhrase) phrase1 el <- elsePart - return $ + return $ text "if" <> parens e $+$ p1 $+$ el where elsePart | isNothing mphrase2 = return $ empty @@ -634,7 +675,7 @@ e <- expr2C expr return $ r <+> text "=" <+> e <> semi _ -> error $ "Assignment to string from " ++ show lt - (BTArray _ _ _, _) -> phrase2C $ + (BTArray _ _ _, _) -> phrase2C $ ProcCall (FunCall [ Reference $ Address ref @@ -654,22 +695,22 @@ e <- expr2C expr cs <- mapM case2C cases d <- dflt - return $ + return $ text "switch" <> parens e $+$ braces (nest 4 . vcat $ cs ++ d) where case2C :: ([InitExpression], Phrase) -> State RenderState Doc case2C (e, p) = do ies <- mapM range2C e ph <- phrase2C p - return $ + return $ vcat (map (\i -> text "case" <+> i <> colon) . concat $ ies) <> nest 4 (ph $+$ text "break;") dflt | isNothing mphrase = return [] | otherwise = do ph <- mapM phrase2C $ fromJust mphrase return [text "default:" <+> nest 4 (vcat ph)] - + phrase2C wb@(WithBlock ref p) = do - r <- ref2C ref + r <- ref2C ref t <- gets lastType case t of (BTRecord _ rs) -> withRecordNamespace (render r ++ ".") rs $ phrase2C $ wrapPhrase p @@ -680,7 +721,7 @@ e1 <- expr2C e1' e2 <- expr2C e2' ph <- phrase2C (wrapPhrase p) - return $ + return $ text "for" <> (parens . hsep . punctuate (char ';') $ [i <+> text "=" <+> e1, i <+> text "<=" <+> e2, text "++" <> i]) $$ ph @@ -716,13 +757,13 @@ e2 <- expr2C expr2 t2 <- gets lastType case (op2C op, t1, t2) of - ("+", BTString, BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strconcat" (BTFunction 2 BTString)) - ("+", BTString, BTChar) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strappend" (BTFunction 2 BTString)) - ("+", BTChar, BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strprepend" (BTFunction 2 BTString)) - ("+", BTChar, BTChar) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_chrconcat" (BTFunction 2 BTString)) - ("==", BTString, BTChar) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strcomparec" (BTFunction 2 BTBool)) - ("==", BTString, BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strcompare" (BTFunction 2 BTBool)) - ("!=", BTString, _) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strncompare" (BTFunction 2 BTBool)) + ("+", BTString, BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strconcat" (BTFunction False 2 BTString)) + ("+", BTString, BTChar) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strappend" (BTFunction False 2 BTString)) + ("+", BTChar, BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strprepend" (BTFunction False 2 BTString)) + ("+", BTChar, BTChar) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_chrconcat" (BTFunction False 2 BTString)) + ("==", BTString, BTChar) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strcomparec" (BTFunction False 2 BTBool)) + ("==", BTString, BTString) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strcompare" (BTFunction False 2 BTBool)) + ("!=", BTString, _) -> expr2C $ BuiltInFunCall [expr1, expr2] (SimpleReference $ Identifier "_strncompare" (BTFunction False 2 BTBool)) ("&", BTBool, _) -> return $ parens e1 <+> text "&&" <+> parens e2 ("|", BTBool, _) -> return $ parens e1 <+> text "||" <+> parens e2 (_, BTRecord t1 _, BTRecord t2 _) -> do @@ -732,7 +773,7 @@ -- aw, "LongInt" here is hwengine-specific hack i <- op2CTyped op [SimpleType (Identifier t1 undefined), SimpleType (Identifier "LongInt" undefined)] ref2C $ FunCall [expr1, expr2] (SimpleReference i) - ("in", _, _) -> + ("in", _, _) -> case expr2 of SetExpression set -> do ids <- mapM (id2C IOLookup) set @@ -801,17 +842,18 @@ modify (\s -> s{lastType = BTInt}) case lt of BTString -> return $ text "Length" <> parens e' - BTArray {} -> return $ text "length_ar" <> parens e' + BTArray RangeInfinite _ _ -> error $ "length() called on variable size array " ++ show e' + BTArray (RangeFromTo _ n) _ _ -> initExpr2C (BuiltInFunction "succ" [n]) _ -> error $ "length() called on " ++ show lt expr2C (BuiltInFunCall params ref) = do - r <- ref2C ref + r <- ref2C ref t <- gets lastType ps <- mapM expr2C params case t of - BTFunction _ t' -> do + BTFunction _ _ t' -> do modify (\s -> s{lastType = t'}) _ -> error $ "BuiltInFunCall lastType: " ++ show t - return $ + return $ r <> parens (hsep . punctuate (char ',') $ ps) expr2C a = error $ "Don't know how to render " ++ show a @@ -820,7 +862,7 @@ i <- id2C IOLookup name t <- gets lastType case t of - BTFunction _ rt -> do + BTFunction _ _ rt -> do modify(\s -> s{lastType = rt}) return $ i <> parens empty _ -> return $ i @@ -828,7 +870,7 @@ i <- ref2C r t <- gets lastType case t of - BTFunction _ rt -> do + BTFunction _ _ rt -> do modify(\s -> s{lastType = rt}) return $ i <> parens empty _ -> return $ i @@ -844,7 +886,7 @@ -- conversion routines ref2C ae@(ArrayElement [expr] ref) = do e <- expr2C expr - r <- ref2C ref + r <- ref2C ref t <- gets lastType case t of (BTArray _ _ t') -> modify (\st -> st{lastType = t'}) @@ -862,13 +904,13 @@ _ -> return $ r <> brackets e ref2C (SimpleReference name) = id2C IOLookup name ref2C rf@(RecordField (Dereference ref1) ref2) = do - r1 <- ref2C ref1 + r1 <- ref2C ref1 t <- fromPointer (show ref1) =<< gets lastType r2 <- case t of BTRecord _ rs -> withRecordNamespace "" rs $ ref2C ref2 BTUnit -> error "What??" a -> error $ "dereferencing from " ++ show a ++ "\n" ++ show rf - return $ + return $ r1 <> text "->" <> r2 ref2C rf@(RecordField ref1 ref2) = do r1 <- ref2C ref1 @@ -888,7 +930,7 @@ r <- fref2C ref t <- gets lastType case t of - BTFunction _ t' -> do + BTFunction _ _ t' -> do ps <- liftM (parens . hsep . punctuate (char ',')) $ mapM expr2C params modify (\s -> s{lastType = t'}) return $ r <> ps @@ -898,10 +940,13 @@ where fref2C (SimpleReference name) = id2C (IOLookupFunction $ length params) name fref2C a = ref2C a - + ref2C (Address ref) = do r <- ref2C ref - return $ text "&" <> parens r + lt <- gets lastType + case lt of + BTFunction True _ _ -> return $ text "&" <> parens (r <> text "__vars") + _ -> return $ text "&" <> parens r ref2C (TypeCast t'@(Identifier i _) expr) = do lt <- expr2C expr >> gets lastType case (map toLower i, lt) of @@ -909,7 +954,7 @@ ("shortstring", BTPointerTo _) -> ref2C $ FunCall [expr] (SimpleReference (Identifier "pchar2str" $ BTString)) (a, _) -> do e <- expr2C expr - t <- id2C IOLookup t' + t <- id2C IOLookup t' return . parens $ parens t <> e ref2C (RefExpression expr) = expr2C expr