fsharp(ygosim): feat: implemented everything from tribute summoning (except tributes don't go to the graveyard yet)
Signed-off-by: prescientmoon <git@moonythm.dev>
This commit is contained in:
parent
79726d5ac5
commit
99ff363652
BIN
fsharp/ygosim/AdobeAIRInstaller.bin
Executable file
BIN
fsharp/ygosim/AdobeAIRInstaller.bin
Executable file
Binary file not shown.
|
@ -1,6 +1,7 @@
|
||||||
module Board
|
module Board
|
||||||
|
|
||||||
open FSharpPlus.Lens
|
open FSharpPlus.Lens
|
||||||
|
open FSharpPlus.Operators
|
||||||
|
|
||||||
module Side =
|
module Side =
|
||||||
open Card.CardInstance
|
open Card.CardInstance
|
||||||
|
@ -124,7 +125,9 @@ module Board =
|
||||||
|
|
||||||
type CardInstance = CardInstance.CardInstance<Board>
|
type CardInstance = CardInstance.CardInstance<Board>
|
||||||
|
|
||||||
type Monster = Card.Monster<Board>
|
type Monster = MonsterTypes.Monster<Board>
|
||||||
|
|
||||||
|
type MonsterInstance = MonsterInstance.MonsterInstance<Board>
|
||||||
|
|
||||||
type Effect = Effect.Effect<Board>
|
type Effect = Effect.Effect<Board>
|
||||||
|
|
||||||
|
@ -147,9 +150,11 @@ module Board =
|
||||||
module Client =
|
module Client =
|
||||||
open Player
|
open Player
|
||||||
open Turn
|
open Turn
|
||||||
|
open Card
|
||||||
open Board
|
open Board
|
||||||
open Utils
|
open Utils
|
||||||
|
|
||||||
|
|
||||||
type Log =
|
type Log =
|
||||||
| CardToHand of string
|
| CardToHand of string
|
||||||
| MonsterSummoned of Monster * int
|
| MonsterSummoned of Monster * int
|
||||||
|
@ -157,35 +162,57 @@ module Client =
|
||||||
| StateChanged of PlayerState * PlayerState
|
| StateChanged of PlayerState * PlayerState
|
||||||
| ChooseZone of int list
|
| ChooseZone of int list
|
||||||
| ChooseMonster of Monster list
|
| ChooseMonster of Monster list
|
||||||
|
| ChooseTributes of Monster list
|
||||||
|
|
||||||
type Client = Log -> int
|
type Client = Log -> int
|
||||||
|
|
||||||
let rec chooseZone client free =
|
let rec chooseZone client free =
|
||||||
let result =
|
let result =
|
||||||
free
|
free |>> view _1
|
||||||
|> List.toIndices
|
|
||||||
|> ChooseZone
|
|> ChooseZone
|
||||||
|> client
|
|> client
|
||||||
|
|
||||||
if List.containsIndex result free then result
|
if List.containsIndex result free then free.[result] ^. _1
|
||||||
else chooseZone client free
|
else chooseZone client free
|
||||||
|
|
||||||
let rec chooseMonster client monsters =
|
let rec chooseMonster client monsters =
|
||||||
let result =
|
let result =
|
||||||
monsters
|
monsters
|
||||||
|> List.map (fun (m, _) -> m)
|
|> List.map (view _1)
|
||||||
|> ChooseMonster
|
|> ChooseMonster
|
||||||
|> client
|
|> client
|
||||||
|
|
||||||
if List.containsIndex result monsters then monsters.[result]
|
if List.containsIndex result monsters then monsters.[result]
|
||||||
else chooseMonster client monsters
|
else chooseMonster client monsters
|
||||||
|
|
||||||
|
let rec chooseTributes client monsters count old: list<MonsterInstance> =
|
||||||
|
match count with
|
||||||
|
| 0 -> old
|
||||||
|
| count ->
|
||||||
|
let resultIndex =
|
||||||
|
monsters
|
||||||
|
|> map (view _1)
|
||||||
|
|> ChooseTributes
|
||||||
|
|> client
|
||||||
|
|
||||||
|
if List.containsIndex resultIndex monsters then
|
||||||
|
let result = monsters.[resultIndex]
|
||||||
|
let withoutCurrent = filter <| Card.MonsterInstance.withoutInstance result <| monsters
|
||||||
|
chooseTributes client withoutCurrent <| count - 1 <| result :: old
|
||||||
|
else
|
||||||
|
chooseTributes client monsters count old
|
||||||
|
|
||||||
|
|
||||||
module Zone =
|
module Zone =
|
||||||
open Player
|
open Player
|
||||||
open Side
|
open Side
|
||||||
open Board
|
open Board
|
||||||
|
|
||||||
let freeMonsterZones (player: Player) = List.filter Option.isNone player.side.monsters
|
let freeMonsterZones (player: Player) =
|
||||||
|
player.side.monsters
|
||||||
|
|> List.indexed
|
||||||
|
|> List.filter (view _2 >> Option.isNone)
|
||||||
|
|
||||||
let freeMonsterZoneCount = freeMonsterZones >> List.length
|
let freeMonsterZoneCount = freeMonsterZones >> List.length
|
||||||
let hasFreeMonsterZones = (>=) << freeMonsterZoneCount
|
let hasFreeMonsterZones = (>=) << freeMonsterZoneCount
|
||||||
let hasFreeMonsterZone player = hasFreeMonsterZones player 1
|
let hasFreeMonsterZone player = hasFreeMonsterZones player 1
|
||||||
|
@ -194,6 +221,7 @@ module Zone =
|
||||||
module Summon =
|
module Summon =
|
||||||
open Card.Card
|
open Card.Card
|
||||||
open Card.Monster
|
open Card.Monster
|
||||||
|
open Player
|
||||||
open Card.CardInstance
|
open Card.CardInstance
|
||||||
open Card
|
open Card
|
||||||
open Board
|
open Board
|
||||||
|
@ -238,25 +266,48 @@ module Summon =
|
||||||
hasNormalSummonableMonster board && board ^. Board.currentPlayerLastNormalSummon < board ^. Board.turn
|
hasNormalSummonableMonster board && board ^. Board.currentPlayerLastNormalSummon < board ^. Board.turn
|
||||||
|
|
||||||
let performNormalSummon client board =
|
let performNormalSummon client board =
|
||||||
|
// Decide what monster to summon
|
||||||
let summonable = normalSummonable board
|
let summonable = normalSummonable board
|
||||||
let target = chooseMonster client summonable
|
let target = chooseMonster client summonable
|
||||||
let (_, _id) = target
|
let (_monster, _id) = target
|
||||||
|
|
||||||
let free = freeMonsterZones <| board ^. Board.currentPlayer
|
// Find what monsters to tribute
|
||||||
|
let tributteCount = numberOfTributes _monster
|
||||||
|
let possibleTributes = board ^. Board.currentPlayerMonsters |>> ((=<<) monster) |> choose id
|
||||||
|
let tributes = chooseTributes client possibleTributes tributteCount []
|
||||||
|
|
||||||
|
// helpers to remove the tributes from the board
|
||||||
|
let replaceInstance instance =
|
||||||
|
let isInstance = List.tryFind (view _2 >> (=) instance.id) tributes |> Option.isSome
|
||||||
|
if isInstance then None
|
||||||
|
else Some instance
|
||||||
|
|
||||||
|
let replaceTributes = map <| Option.bind replaceInstance
|
||||||
|
|
||||||
|
// Tribute monsters
|
||||||
|
let boardWithoutTributes = board |> over Board.currentPlayerMonsters replaceTributes
|
||||||
|
let free = freeMonsterZones <| boardWithoutTributes ^. Board.currentPlayer
|
||||||
|
|
||||||
|
// TODO: move tributes to graveyard
|
||||||
|
|
||||||
|
// Choose a zone to summon the monster
|
||||||
let zone = chooseZone client free
|
let zone = chooseZone client free
|
||||||
|
let turn = boardWithoutTributes ^. Board.turn
|
||||||
|
|
||||||
let turn = board ^. Board.turn
|
// Instance to actually summon
|
||||||
|
|
||||||
let summonedInstance =
|
let summonedInstance =
|
||||||
target
|
target
|
||||||
|> toCardInstance
|
|> toCardInstance
|
||||||
|> Some
|
|> Some
|
||||||
|
|
||||||
|
// Remove card from hand
|
||||||
let removeTarget = List.filter (fun card -> card.id <> _id)
|
let removeTarget = List.filter (fun card -> card.id <> _id)
|
||||||
|
|
||||||
|
// Notify the client a new monster was summoned
|
||||||
client <| MonsterSummoned(target ^. _1, zone) |> ignore
|
client <| MonsterSummoned(target ^. _1, zone) |> ignore
|
||||||
|
|
||||||
board
|
// Update the board
|
||||||
|
boardWithoutTributes
|
||||||
|> over Board.currentPlayerHand removeTarget
|
|> over Board.currentPlayerHand removeTarget
|
||||||
|> (Board.currentPlayerMonsters << Lens.indexToLens zone) .-> summonedInstance
|
|> (Board.currentPlayerMonsters << Lens.indexToLens zone) .-> summonedInstance
|
||||||
|> Board.currentPlayerLastNormalSummon .-> turn
|
|> Board.currentPlayerLastNormalSummon .-> turn
|
||||||
|
@ -283,7 +334,7 @@ module Game =
|
||||||
|> Board.currentPlayerHand .-> hand
|
|> Board.currentPlayerHand .-> hand
|
||||||
|> Board.currentPlayerDeck .-> deck
|
|> Board.currentPlayerDeck .-> deck
|
||||||
|
|
||||||
let toDeckBottom (card: CardInstance) (player: Player) = over Player.deck (fun d -> card :: d) player
|
let toDeckBottom (card: CardInstance) (player: Player) = over Player.deck (fun d -> rev <| card :: rev d) player
|
||||||
|
|
||||||
let handleMainPhase client board =
|
let handleMainPhase client board =
|
||||||
if canNormalSummon board then performNormalSummon client board
|
if canNormalSummon board then performNormalSummon client board
|
||||||
|
|
|
@ -1,6 +1,7 @@
|
||||||
module Card
|
module Card
|
||||||
|
|
||||||
open FSharpPlus.Lens
|
open FSharpPlus.Lens
|
||||||
|
open FSharpPlus.Operators
|
||||||
|
|
||||||
module Effect =
|
module Effect =
|
||||||
type Condition<'s> = 's -> bool
|
type Condition<'s> = 's -> bool
|
||||||
|
@ -28,8 +29,7 @@ module Effect =
|
||||||
let inline resolve f effect = f effect.resolve <&> fun r -> { effect with resolve = r }
|
let inline resolve f effect = f effect.resolve <&> fun r -> { effect with resolve = r }
|
||||||
let inline _type f effect = f effect._type <&> fun t -> { effect with _type = t }
|
let inline _type f effect = f effect._type <&> fun t -> { effect with _type = t }
|
||||||
|
|
||||||
|
module BaseCard =
|
||||||
module Card =
|
|
||||||
open Effect
|
open Effect
|
||||||
|
|
||||||
type BaseCard<'s> =
|
type BaseCard<'s> =
|
||||||
|
@ -42,18 +42,10 @@ module Card =
|
||||||
let inline text f card = f card.text <&> fun v -> { card with text = v }
|
let inline text f card = f card.text <&> fun v -> { card with text = v }
|
||||||
let inline effects f card = f card.effects <&> fun v -> { card with effects = v }
|
let inline effects f card = f card.effects <&> fun v -> { card with effects = v }
|
||||||
|
|
||||||
type SpellCardType =
|
|
||||||
| NormalSpell
|
|
||||||
| Field
|
|
||||||
| Equip
|
|
||||||
| ContinuosSpell
|
|
||||||
| QuickPlay
|
|
||||||
| Ritual
|
|
||||||
|
|
||||||
type TrapCardType =
|
module MonsterTypes =
|
||||||
| NormalTrap
|
open BaseCard
|
||||||
| Counter
|
|
||||||
| ContinuosTrap
|
|
||||||
|
|
||||||
type Attribute =
|
type Attribute =
|
||||||
| Dark
|
| Dark
|
||||||
|
@ -91,19 +83,6 @@ module Card =
|
||||||
| Wyrm
|
| Wyrm
|
||||||
| Zombie
|
| Zombie
|
||||||
|
|
||||||
type SpellCardDetails =
|
|
||||||
{ spellType: SpellCardType }
|
|
||||||
|
|
||||||
module SpellCardDetails =
|
|
||||||
let inline spellType f card = f card.spellType <&> fun v -> { card with spellType = v }
|
|
||||||
|
|
||||||
type TrapCardDetails =
|
|
||||||
{ trapType: TrapCardType }
|
|
||||||
|
|
||||||
module TrapCardDetails =
|
|
||||||
let inline trapType f card = f card.trapType <&> fun v -> { card with trapType = v }
|
|
||||||
|
|
||||||
|
|
||||||
type MonsterCardDetails =
|
type MonsterCardDetails =
|
||||||
{ attack: int
|
{ attack: int
|
||||||
defense: int
|
defense: int
|
||||||
|
@ -117,8 +96,39 @@ module Card =
|
||||||
let inline attribute f card = f card.attribute <&> fun v -> { card with attribute = v }
|
let inline attribute f card = f card.attribute <&> fun v -> { card with attribute = v }
|
||||||
let inline level f card = f card.level <&> fun v -> { card with level = v }
|
let inline level f card = f card.level <&> fun v -> { card with level = v }
|
||||||
|
|
||||||
|
|
||||||
type Monster<'s> = BaseCard<'s> * MonsterCardDetails
|
type Monster<'s> = BaseCard<'s> * MonsterCardDetails
|
||||||
|
|
||||||
|
module Card =
|
||||||
|
open BaseCard
|
||||||
|
open MonsterTypes
|
||||||
|
|
||||||
|
type SpellCardType =
|
||||||
|
| NormalSpell
|
||||||
|
| Field
|
||||||
|
| Equip
|
||||||
|
| ContinuosSpell
|
||||||
|
| QuickPlay
|
||||||
|
| Ritual
|
||||||
|
|
||||||
|
type TrapCardType =
|
||||||
|
| NormalTrap
|
||||||
|
| Counter
|
||||||
|
| ContinuosTrap
|
||||||
|
|
||||||
|
type SpellCardDetails =
|
||||||
|
{ spellType: SpellCardType }
|
||||||
|
|
||||||
|
module SpellCardDetails =
|
||||||
|
let inline spellType f card = f card.spellType <&> fun v -> { card with spellType = v }
|
||||||
|
|
||||||
|
type TrapCardDetails =
|
||||||
|
{ trapType: TrapCardType }
|
||||||
|
|
||||||
|
module TrapCardDetails =
|
||||||
|
let inline trapType f card = f card.trapType <&> fun v -> { card with trapType = v }
|
||||||
|
|
||||||
|
|
||||||
type Card<'s> =
|
type Card<'s> =
|
||||||
| Monster of Monster<'s>
|
| Monster of Monster<'s>
|
||||||
| Spell of BaseCard<'s> * SpellCardDetails
|
| Spell of BaseCard<'s> * SpellCardDetails
|
||||||
|
@ -144,10 +154,11 @@ module CardInstance =
|
||||||
|
|
||||||
|
|
||||||
module Monster =
|
module Monster =
|
||||||
open Card
|
open MonsterTypes
|
||||||
open CardInstance
|
open CardInstance
|
||||||
|
open Card
|
||||||
|
|
||||||
let monster card: option<Monster<'s> * int> =
|
let monster card: option<Monster<'a> * int> =
|
||||||
match card.template with
|
match card.template with
|
||||||
| Monster m -> Some(m, card.id)
|
| Monster m -> Some(m, card.id)
|
||||||
| _ -> None
|
| _ -> None
|
||||||
|
@ -157,6 +168,20 @@ module Monster =
|
||||||
{ template = Monster card
|
{ template = Monster card
|
||||||
id = _id }
|
id = _id }
|
||||||
|
|
||||||
|
module MonsterInstance =
|
||||||
|
open MonsterTypes
|
||||||
|
|
||||||
|
type MonsterInstance<'s> = Monster<'s> * int
|
||||||
|
|
||||||
|
module private Internals =
|
||||||
|
// idk how to preperly override (=)
|
||||||
|
let areEqual (_, _id1) (_, _id2) = _id1 = _id2
|
||||||
|
let (==) = areEqual
|
||||||
|
|
||||||
|
open Internals
|
||||||
|
|
||||||
|
let withoutInstance instance = areEqual instance >> not
|
||||||
|
|
||||||
module Decklist =
|
module Decklist =
|
||||||
type Decklist =
|
type Decklist =
|
||||||
{ main: int list
|
{ main: int list
|
||||||
|
|
|
@ -5,6 +5,8 @@
|
||||||
open Board.Game
|
open Board.Game
|
||||||
open Board.Client
|
open Board.Client
|
||||||
open Card.Card
|
open Card.Card
|
||||||
|
open Card.MonsterTypes
|
||||||
|
open Card.BaseCard
|
||||||
|
|
||||||
let printState state =
|
let printState state =
|
||||||
match state with
|
match state with
|
||||||
|
@ -24,10 +26,27 @@
|
||||||
attribute = Fire
|
attribute = Fire
|
||||||
race = Warrior })
|
race = Warrior })
|
||||||
|
|
||||||
|
let tributeCardTemplate =
|
||||||
|
Monster ({ name= "sampleCard2"
|
||||||
|
text="something"
|
||||||
|
effects = []}
|
||||||
|
,{ attack = 3000
|
||||||
|
defense = 2500
|
||||||
|
level = 7
|
||||||
|
attribute = Fire
|
||||||
|
race = Warrior })
|
||||||
|
|
||||||
let (sampleCard, initialBoard) = instantiate emptyBoard sampleCardTemplate
|
let (sampleCard1, board1) = instantiate emptyBoard sampleCardTemplate
|
||||||
|
let (sampleCard2, board2) = instantiate board1 sampleCardTemplate
|
||||||
|
let (sampleCard3, board3) = instantiate board2 sampleCardTemplate
|
||||||
|
let (sampleCard4, board4) = instantiate board3 sampleCardTemplate
|
||||||
|
let (tributeCard, board5) = instantiate board4 tributeCardTemplate
|
||||||
|
|
||||||
let board = over Board.firstPlayer <| toDeckBottom sampleCard <| initialBoard
|
let board6 = over Board.firstPlayer <| toDeckBottom sampleCard1 <| board5
|
||||||
|
let board7 = over Board.firstPlayer <| toDeckBottom sampleCard2 <| board6
|
||||||
|
let board8 = over Board.secondPlayer <| toDeckBottom sampleCard3 <| board7
|
||||||
|
let board9 = over Board.secondPlayer <| toDeckBottom sampleCard4 <| board8
|
||||||
|
let board10 = over Board.firstPlayer <| toDeckBottom tributeCard <| board9
|
||||||
|
|
||||||
let client action =
|
let client action =
|
||||||
match action with
|
match action with
|
||||||
|
@ -40,14 +59,13 @@
|
||||||
0
|
0
|
||||||
| ChooseZone free ->
|
| ChooseZone free ->
|
||||||
printfn "What Zone do wou want to use? %A" free
|
printfn "What Zone do wou want to use? %A" free
|
||||||
let i = System.Console.ReadLine() |> int
|
System.Console.ReadLine() |> int
|
||||||
|
|
||||||
free.[i]
|
|
||||||
| ChooseMonster monsters ->
|
| ChooseMonster monsters ->
|
||||||
printfn "What monster do you want to choose? %A" <| List.map (fun (_base, details) -> _base.name) monsters
|
printfn "What monster do you want to choose? %A" <| List.map (fun (_base, details) -> _base.name) monsters
|
||||||
let i = System.Console.ReadLine() |> int
|
System.Console.ReadLine() |> int
|
||||||
|
| ChooseTributes monsters ->
|
||||||
i
|
printfn "What monster do you want to tribute? %A" <| List.map (fun (_base, details) -> _base.name) monsters
|
||||||
|
System.Console.ReadLine() |> int
|
||||||
| MonsterSummoned (card, zone) ->
|
| MonsterSummoned (card, zone) ->
|
||||||
printfn "Monster %A was summoned in zone %i" card zone
|
printfn "Monster %A was summoned in zone %i" card zone
|
||||||
0
|
0
|
||||||
|
@ -55,7 +73,7 @@
|
||||||
printfn "Something unkown happened"
|
printfn "Something unkown happened"
|
||||||
0
|
0
|
||||||
|
|
||||||
let finalBoard = game board client
|
let finalBoard = game board10 client
|
||||||
|
|
||||||
printfn "The final baord was: %A" finalBoard
|
printfn "The final baord was: %A" finalBoard
|
||||||
|
|
||||||
|
|
|
@ -7,8 +7,6 @@ module List =
|
||||||
else previous)
|
else previous)
|
||||||
|
|
||||||
|
|
||||||
let (.->) = setIndex
|
|
||||||
|
|
||||||
let toIndices list = List.mapi (fun i _ -> i) list
|
let toIndices list = List.mapi (fun i _ -> i) list
|
||||||
let containsIndex index list = index >= 0 && index < List.length list
|
let containsIndex index list = index >= 0 && index < List.length list
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue