game.rkt

#lang racket

(require "ascii.rkt")


;; ============================================================
;; Model:


(define msg-inicial "Olá, seja bem vindo ao Parque de Diversões Caverna de Platão! Prepare-se para viver grandes momentos
de aventura! Você precisará ser muito esperto para completar todas as missões e ganhar todos os pontos
necessários para receber nossos grandiosos prêmios. E também muito corajoso, porque... Não, não vamos
adiantar o que há por vir. Se arrisque e descubra tudo que o parque tem a oferecer. Esperamos
que você se saia bem, e principalmente, se divirta. Lembre-se sempre de ficar atento à sua mochila,
ela pode carregar coisas valiosas em vários momentos.
Boa sorte!")



;; Elements of the world:
(struct verb (aliases       ; list of symbols
              desc          ; string
              transitive?)) ; boolean

(struct thing (name         ; symbol
               [state #:mutable] ; any value  ----> ESTADO DE USO: EM USO OU NÃO
               actions))    ; list of verb--thing pairs

(struct place (desc         ; string
               [things #:mutable] ; list of things
               actions))    ; list of verb--thing pairs

(struct state (desc ;string
               [status #:mutable]
))
 
(struct ride (desc 
              [state #:mutable])) ;define if the character has ridden a feature

;; Tables mapping names<->things for save and load
(define names (make-hash))
(define elements (make-hash))

(define (record-element! name val)
  (hash-set! names name val)
  (hash-set! elements val name))

(define (name->element name) (hash-ref names name #f))
(define (element->name obj) (hash-ref elements obj #f))


;; ============================================================
;; Macros for constructing and registering elements:

(define-syntax-rule (define-verbs all-id
                      [id spec ...] ...)
  (begin
    (define-one-verb id spec ...) ...
    (record-element! 'id id) ...
    (define all-id (list id ...))))

(define-syntax define-one-verb
  (syntax-rules (= _)
    [(define-one-verb id (= alias ...) desc)
     (define id (verb (list 'id 'alias ...) desc #f))]
    [(define-one-verb id _ (= alias ...) desc)
     (define id (verb (list 'id 'alias ...) desc #t))]
    [(define-one-verb id)
     (define id (verb (list 'id) (symbol->string 'id) #f))]
    [(define-one-verb id _)
     (define id (verb (list 'id) (symbol->string 'id) #t))]))


(define-syntax-rule (define-thing id 
                      [vrb expr] ...)
  (begin
    (define id 
      (thing 'id #f (list (cons vrb (lambda () expr)) ...)))
    (record-element! 'id id)))


(define-syntax-rule (define-place id 
                      desc 
                      (thng ...) 
                      ([vrb expr] ...))
  (begin
    (define id (place desc
                      (list thng ...)
                      (list (cons vrb (lambda () expr)) ...)))
    (record-element! 'id id)))


(define-syntax-rule (define-everywhere id ([vrb expr] ...))
  (define id (list (cons vrb (lambda () expr)) ...)))


; Define points to the player

(define (soma-pontos [p 0])
  (let ([n 0])
    (lambda (p)
      (set! n (+ n p))
      n)))

(define pontuar (soma-pontos))

(define pontos-brinquedo 150)

(define pontos-bonus 200)

(define (mostrar-pontos)
  (printf "Você tem ~a pontos\n" (pontuar 0)))

(define (verifica-pontos)
  (let ([pontos (pontuar 0)])
    (cond
      [(eq? pontos 1000)
        (printf "\n\n\nPARABÉNS, VOCÊ GANHOU! O SEU PRÊMIO É ENTRADA GRATUITA E VITALÍCIA PARA TODOS OS BRINQUEDOS DO PARQUE CAVERNA DE PLATÃO, ALÉM DESSE BELO TROFÉU! ~a\n\n\n"
 trofeu)]
      [(eq? pontos 950)
            (printf "\n\n\nAAAH, QUASE! VOCÊ FOI MUITO BEM, MAS INFELIZMENTE NÃO GANHOU O NOSSO MAIOR PRÊMIO :(
MAS OLHA SÓ, VOCÊ AINDA VAI LEVAR PARA CASA ESTE TROFÉU!\n\n\n ~a" trofeu)]
      [else
       (printf "\n\n\nAAH, POXA VIDA :( NÃO FOI DESSA VEZ QUE VOCÊ GANHOU NOSSOS MARAVILHOSOS PRÊMIOS. TENTE NOVAMENTE, ADORAMOS TER VOCÊ POR AQUI!\n\n\n")])))

(define (andou-todos-brinquedos)
  (if (>= (length rides-states) 4)
      #t
      #f))
      

;; ============================================================
;; The world:

;; Verbs ----------------------------------------
;; Declare all the verbs that can be used in the game.
;; Each verb has a canonical name, a set of aliases, 
;; a printed form, and a boolean indincating whether it
;; is transitive.


(define-verbs all-verbs
  [north (= n norte) "ir ao norte"]
  [south (= s sul) "ir ao sul"]
  [east (= e leste) "ir ao leste"]
  [west (= w oeste) "ir ao oeste"]
  [in (= enter entrar) "entrar"]
  [out (= leave sair) "sair"]
  [get _ (= grab take pegar) "pegar"]
  [put _ (= drop leave largar soltar) "soltar"]
  [open _ (= unlock abrir) "abrir"]
  [close _ (= lock fechar) "fechar"]
  [quit (= exit sair desistir encerrar) "desistir"]
  [look (= show olhar) "olhar"]
  [inventory (= mochila) "mostrar objetos da mochila"]
  [mind (= mente estado) "demonstrar estado do personagem"]
  [buy (= comprar) "comprar"]
  [eat _ (= comer) "comer"]
  [usar _ (=) "usar artefato"]
  [acender _ (= acionar ligar) "acender"]
  [pontos (= pontuacao) "ver pontos"]
  [talk _ (= chamar falar conversar interagir invocar) "falar"]
  [save]
  [load]
  [ajuda]
  
  )




#|
;; Removed by Manoel Mendonca
(define all-verbs
  (list north south east west up down in out
        get put open close knock quit
        look inventory help save load buy eat talk))
|#


;; Added by Manoel Mendonca 25/03/2021
;; ame result as before, but much safer
;(define all-the-verbs (filter verb? (hash-keys elements)))


;; Global actions ----------------------------------------
;; Handle verbs that work anywhere.

(define everywhere-actions
  (list
   (cons quit (lambda () (begin (verifica-pontos) (printf "Espero que tenha se divertido. Tchau! ;)\n") (exit))))
   (cons look (lambda () (show-current-place)))
   (cons inventory (lambda () (show-inventory)))
   (cons mind (lambda () (show-states)))
   (cons save (lambda () (save-game)))
   (cons load (lambda () (load-game)))
   (cons ajuda (lambda () (show-help)))
   (cons pontos (lambda () (mostrar-pontos)))))

;; Things ----------------------------------------
;; Each thing handles a set of transitive verbs.


(define-thing ticket
  [get (if (have-thing? ticket)
                      "Voce ja esta com o ticket."
                      (begin
                        (take-thing! ticket)
                        "Voce pegou o ticket."))]
  [open (begin
          (printf "Você brincou")
              (if (null? rides-states)
              (printf " em nada ainda.")
              (for-each (lambda (ride) ; aplica esta função a cada coisa da lista
                  (printf "\n -> ~a." (ride-desc ride)))
                rides-states))
                (printf "\n"))]
  [put (if (have-thing? ticket)
                      (begin
                        (drop-thing! ticket)
                        "Voce soltou o ticket.")
                      "Voce nao esta com o ticket.")])



(define-thing lanterna
  [get (if (have-thing? lanterna)
           "Voce ja esta com a lanterna."
           (begin
             (take-thing! lanterna)
             "Voce pegou a lanterna. Ela agora está em sua mochila."))]
  [put (if (have-thing? lanterna)
           (begin
             (drop-thing! lanterna)
             "Voce soltou a lanterna.")
           "Voce nao esta com a lanterna.")]
  [usar  (begin
           (if (have-thing? lanterna)
               (if (eq? current-place mansao-interior)
                   (begin (use-thing lanterna "Agora que a lanterna está acesa você consegue ver algumas coisas dentro da mansão.")
                          (pontuar pontos-bonus))
                   "A lanterna está acesa.")
               "Voce nao esta com a lanterna")
           )]
  [acender (begin
             (if (have-thing? lanterna)
                 (if (eq? current-place mansao-interior)
                     (begin (use-thing lanterna "Agora que a lanterna está acesa você consegue ver algumas coisas dentro da mansão.")
                            (pontuar pontos-bonus))
                     "A lanterna está acesa.")
                 "Voce nao esta com a lanterna")
             )])
  

(define-thing binoculos
  [get (if (have-thing? binoculos)
                      "Voce ja esta com o binoculos."
                      (begin
                        (take-thing! binoculos)
                        "Voce pegou o binoculos. Ele agora está em sua mochila."))]
  [put (if (have-thing? binoculos)
                      (begin
                        (drop-thing! binoculos)
                        "Voce soltou o binoculos.")
                      "Voce nao esta com o binoculos.")]
  [usar (begin
                  (if (have-thing? binoculos)
                    (if (eq? current-place topo-roda-gigante)
                      (begin (pontuar pontos-bonus) "Que incrível! Está tudo tão perto agora, você consegue ver todos os detalhes... Usando o binóculos você contempla totalmente a vista do parque, se estendendo pelo vale onde ele se encontra." )
                      (use-thing binoculos "Que incrível! Está tudo tão perto agora, você consegue ver todos os detalhes... "))
                      "Voce nao esta com o binoculos")
          )])

(define-thing comida
  [eat (if (have-thing? comida)
                      (and (set-player-state! barriga-cheia) (consume-thing! comida) "Você se sente revigorado e pronto para explorar o parque. Só tome cuidado para não passar mal em certos brinquedos...")
                      "Voce nao tem nada para comer.")])

(define-thing pessoa
  [talk (if (thing-state pessoa)
            "Olá de novo, amigo. Espero que esteja se divertindo."
              (begin 
                (take-thing! binoculos) 
                (set-thing-state! pessoa #t) 
                (printf "Olá, amigo. Esse parque proporciona uma visão sensacional. É tão boa que quero que todos saibam como é bonito.\n")
                "Então por favor, aceite esse binóculos como presente para você aproveitar ao máximo."))])


(define-thing caixa
  [open (if (have-thing? lanterna)
          "Não há nada aqui."
          (begin (take-thing! lanterna) "Você encontrou uma lanterna!"))])

(define-thing presenca
  [talk (if (thing-state lanterna)
      (if (thing-state presenca)
      (begin (set-player-state! amedrontado) fofao)
      (begin (set-thing-state! presenca #t) "Por estar com a lanterna acesa, você percebe que a presenca na sala nada mais é que um boneco do fofão mofado. Apesar da sua face bizarra, você se sente mais tranquilo.")
      )
      (begin (set-player-state! amedrontado) "..."))])

;; States ----------------------------------------
;; Each state changes how the player will react.

(define barriga-cheia (state "de barriga cheia" #f))
(define amedrontado (state "amedrontado" #f))

;; Ride States ----------------------------------------
;; Define if a ride was taken

(define ticket-carrossel (ride "carrossel" #f))
(define ticket-montanha-russa (ride "montanha-russa" #f))
(define ticket-mansao (ride "mansao do terror" #f))
(define ticket-roda-gigante (ride "roda-gigante" #f))


;; Places ----------------------------------------
;; Each place handles a set of non-transitive verbs.

(define (brincar ride [msg ""] #:place [place null] #:penalties [number 0])
      (if (is-ridden? ride)
        "Você já foi nesse brinquedo! Tente outros brinquedos."
        (begin (set-ticket-rides! ride) (pontuar (- pontos-brinquedo number)) (printf "~a\n" msg) place)
))


(define-place entrada 
 "Você está na bilheteria do parque. Pegue o seu ticket de entrada, que dará acesso aos nossos brinquedos."
 [ticket]
 ([north praca]
  [out (begin (verifica-pontos) (exit))]))


(define-place praca
  "Você está numa pracinha. Existe uma fonte no centro. Há uma grande movimentação de pessoas."
  [pessoa]
  ([north montanha-russa]
   [east mansao]
   [south entrada]
   [west lago]))



(define-place montanha-russa
  "Você chegou na Montanha Russa, a atração do parque"
  []
  ([in (begin
         (if (have-thing? ticket)
    (if (member barriga-cheia player-state)
      (brincar ticket-montanha-russa  "O passeio foi um pouco radical demais, e você não está se sentindo bem. Algo não bateu certo... Logo depois de sair do carro, você passa mal e vomita tudo que comeu até aqui." #:penalties 50)
      (brincar ticket-montanha-russa "A montanha russa te proporcionou uma adrenalina que você nunca tinha visto antes! Você sente que nada mais pode te assustar. Ou será que não...?"))
      "Alto lá! A montanha russa é um dos brinquedos mais movimentados do parque. Você precisa apresentar o seu ticket de entrada para poder brincar."))]
   [south praca]))


(define-place carrossel
  "Você chegou ao Carrossel. Ele é muito bonito, com muitas luzes coloridas."
  []
  ([in (begin
            (if (have-thing? ticket)
                (brincar ticket-carrossel "A movimentação do carrossel te deixa tranquilo. Você se lembra do tempo quando ia para o parque quando criança. Você se sente determinado.")
                "Você não tem o ticket para entrar no brinquedo. Como você entrou no parque sem um ticket? Temos aqui um invasor?"
                ))]
   [east lago]))


(define-place lago
  "Você se depara com um pequeno lago. Na sua beirada, há um barco."
  []
  ([in barco]
   [north roda-gigante]
   [east praca]
   [south barracas]
   [west carrossel]))


(define-place barco
  "Você está dentro de um barquinho"
  [caixa]
  ([out lago]))


(define-place roda-gigante
  "Você está em frente à Roda Gigante e... UAU! Ela é realmente GIGANTE. Com certeza te dará uma boa visão do parque."
  []
  ([in (begin
         (if (have-thing? ticket)
        (brincar ticket-roda-gigante "Você entra na roda-gigante bastante empolgado com a vista que te espera lá de cima." #:place topo-roda-gigante)
        "Para entrar num brinquedo você precisa mostrar o seu ticket. Será que você o perdeu?"))]
   [south lago]))

(define-place topo-roda-gigante
  "A roda gigante é muito alta e você vê as pessoas lá em baixo como formiguinhas. A visão é muito bonita, seria legal aproveitar essa vista de uma forma mais proveitosa."
  []
  ([out roda-gigante]
   [south roda-gigante]))

(define-place mansao
  "Você chegou na Mansão do Terror. Diz a lenda que criaturas sobrenaturais que já estavam aqui antes da fundação
do parque escolheram este lugar como a sua casa. Entre se quiser, saia se puder."
  []
  ([in (begin
        (if (have-thing? ticket)
       (begin (brincar ticket-mansao "Você toma coragem e decide enfrentar a Mansão do Terror!" #:place mansao-interior) )
       "Para entrar num brinquedo você precisa mostrar o seu ticket. Será que você o perdeu?"))]
   [west praca]))


(define-place mansao-interior
  "Você está dentro da Mansão do Terror. O ambiente é bem escuro, e você percebe alguns ruídos."
  [presenca]
  ([out mansao]))
  
(define-place barracas
  "Seguindo o aroma, você chegou nas barraquinhas de comida."
  []
  ([buy (begin (and (take-thing! comida) "Você comprou comida."))]
   [north lago]))


;; ============================================================
;; Game state

;; Things carried by the player:
(define stuff null) ; list of things

;; States of the player:
(define player-state null) ; list of states

;;Rides on attractions
(define rides-states null)

;; Current location:
(define current-place entrada) ; place

;; Fuctions to be used by verb responses:
(define (have-thing? t)
  (memq t stuff))

(define (take-thing! t) 
  (set-place-things! current-place
                     (remq t (place-things current-place)))
  (set! stuff (cons t stuff)))

(define (drop-thing! t) 
  (set-place-things! current-place
                     (cons t (place-things current-place)))
  (set! stuff (remq t stuff)))

(define (consume-thing! t) 
  (set! stuff (remq t stuff)))

(define (use-thing t msg)
  (if
   (eq? (thing-state t) #f) (set-thing-state! t #t)
   (set-thing-state! t #f))
  (printf "~a\n" msg)
  )


(define (set-player-state! s)
  (set! player-state (cons s player-state)))

(define (is-ridden? r)
 (memq r rides-states))

(define (set-ticket-rides! r)
 (set! rides-states (cons r rides-states)))

;; ============================================================
;; Game execution

;; Inicializes and begin
;; Show the player the current place, then get a command:
(define (do-place)
  (show-current-place) ; mostra lugar atual
  (do-verb))           ; executa comando

;; Show the current place:
(define (show-current-place)
  (printf "~a\n" (place-desc current-place)) ; imprime o lugar
  (for-each (lambda (thing)      ; imprime as coisas do lugar
              (printf "Tem um(a) ~a aqui.\n" (thing-name thing)))
            (place-things current-place)))

;; Main loop
;; Get and handle a command:
(define (do-verb)
  (printf "> ")             ; imprime o prompt
  (flush-output)
  (let* ([line (read-line)] ; lê comando
         [input (if (eof-object? line)  ; vê se foi um comando de fim de arquivo
                    '(quit)             ; se sim, sai
                    (let ([port (open-input-string line)]) ; se não, coloca palavras
                      (for/list ([v (in-port read port)]) v)))])  ; em "input"
    (if (and (list? input)            ; se input é lista,
             (andmap symbol? input)   ; tem só símbolos,
             (<= 1 (length input) 2)) ; e tem um ou dois símbolos, é um comando correto
        (let ([cmd (car input)]) ;; o comando principal, verbo, é o começo da lista
            (let ([response ;; monta resposta para verbos
                   (cond
                    [(= 2 (length input))
                     (handle-transitive-verb cmd (cadr input))] ;; transitivos
                    [(= 1 (length input))
                     (handle-intransitive-verb cmd)])])         ;; intransitivos
              (let ([result (response)]) ;; resposta é uma função, execute-a
                (cond
                 [(place? result) ;; se o resultado for um lugar
                  (set! current-place result) ;; ele passa a ser o novo lugar
                  (do-place)]   ;; faça o processamento do novo lugar, loop
                 [(string? result) ; se a resposta for uma string
                  (printf "~a\n" result)  ; imprima a resposta
                  (do-verb)]    ; volte a processar outro comando, loop
                 [else (do-verb)])))) ; caso contrário, outro comando, loop
          (begin ; comando incorreto
            (printf "Desculpe, não entendi.\n")
            (do-verb)))))


;; Handle an intransitive-verb command:
;; retorna função para processar verbo intrasitivo

(define (handle-intransitive-verb cmd)
  (or
   ; considerando o lugar, retorna a ação associada ao verbo
   (find-verb cmd (place-actions current-place))
   ; se não achou no lugar, considerando o jogo todo, retorna a ação associada ao verbo
   (find-verb cmd everywhere-actions)
   ; se não achou no lugar ou no geral, mas o verbo existe
   ; retorna uma função que dá uma mensagem de erro em contexto
   (using-verb  ; procura o verbo, obtem info descritiva, e retorna a função abaixo
    cmd all-verbs
    (lambda (verb)
      (lambda () ; função retornada por using-verb, mensagem de erro em contexto
        (if (verb-transitive? verb)
            (format "~a o quê?" (string-titlecase (verb-desc verb)))
            (format "Impossível ~a aqui." (verb-desc verb))))))
   (lambda () ; não achou o verbo no jogo
     (format "Desculpe, eu não sei como ~a." cmd))))

;; Handle a transitive-verb command:
(define (handle-transitive-verb cmd obj)
  (or (using-verb ; produz ação para verbo, retorna falso se não achar verbo no jogo
       cmd all-verbs
       (lambda (verb) ; função retornada
         (and ; retorna falso se alguma destas coisas for falsa
          (verb-transitive? verb) ; verbo é transitivo? - funcão criada por struct 
          (cond
           [(ormap (lambda (thing) ; verifica se o objeto nomeado existe em contexto
                     (and (eq? (thing-name thing) obj)
                          thing))
                   ; na lista das coisas do lugar e das coisas que tenho (stuff)
                   (append (place-things current-place) 
                           stuff))
            => (lambda (thing) ; se existe, aplica esta função sobre a coisa/thing
                 (or (find-verb cmd (thing-actions thing)) ; retorna acão que se aplica a coisa
                     (lambda () ; se ação não encontrada, indica que não há ação
                       (format "Não sei como ~a ~a."
                               (verb-desc verb) obj))))]
           [else ; se objeto não existe
            (lambda ()
              (format "Não há nenhum(a) ~a aqui para ~a." obj 
                      (verb-desc verb)))]))))
      (lambda ()  ; se não achou o verbo
        (format "I don't know how to ~a ~a." cmd obj))))

;; Show what the player is carrying:
(define (show-inventory)
  (printf "Na sua mochila você")
  (if (null? stuff)
      (printf " não tem nada.")
      (for-each (lambda (thing) ; aplica esta função a cada coisa da lista
                  (printf "\n  -> tem um(a) ~a" (thing-name thing)))
                stuff))
  (printf "\n"))

;; Show how the player are:
(define (show-states)
  (printf "Você está")
  (if (null? player-state)
      (printf " se sentindo normal.")
      (for-each (lambda (desc) ; aplica esta função a cada coisa da lista
                  (printf "\n -> ~a." (state-desc desc)))
                player-state))
  (printf "\n"))

;; Look for a command match in a list of verb--response pairs,
;; and returns the response thunk if a match is found:
(define (find-verb cmd actions)
  (ormap (lambda (a)
           (and (memq cmd (verb-aliases (car a)))
                (cdr a)))
         actions))

;; Looks for a command in a list of verbs, and
;; applies `success-k' to the verb if one is found:
(define (using-verb cmd verbs success-k)
  (ormap (lambda (vrb)
           (and (memq cmd (verb-aliases vrb))
                (success-k vrb)))
         verbs))

;; Print help information:
(define (show-help)
  (printf "Use 'olhar' para olhar o que há em volta.\n")
  (printf "Use 'mochila' para ver os objetos que você está levando consigo.\n")
  (printf "Use 'mente' ou 'estado' para ver o estado do seu personagem\n")
  (printf "Use 'salvar' ou 'carregar' para salvar ou restaurar um jogo\n")
  (printf "Use 'pontos' para ver seu total de pontos até o momento\n")
  (printf "Use 'abrir ticket' para ver os brinquedos que você já utilizou até o momento\n")
  (printf "Use 'sair' para  encerrar a partida e receber o resultado se você ganhou os prêmios ou não\n")
  (printf "Existe alguns outros verbos, e você pode nomear uma coisa a partir de um verbo.\n"))
  

;; ============================================================
;; Save and load

;; Prompt the user for a filename and apply `proc' to it,
;; catching errors to report a reasonably nice message:
(define (with-filename proc)
  (printf "File name: ")
  (flush-output)
  (let ([v (read-line)])
    (unless (eof-object? v)
      (with-handlers ([exn? (lambda (exn)
                              (printf "~a\n" (exn-message exn)))])
        (unless (path-string? v)
          (raise-user-error "bad filename"))
        (proc v)))))

;; Save the current game state:
(define (save-game)
  (with-filename
   (lambda (v)
     (with-output-to-file v
       (lambda ()
         (write
          (list
           (map element->name stuff)
           (element->name current-place)
           (hash-map names
                     (lambda (k v)
                       (cons k
                             (cond
                              [(place? v) (map element->name (place-things v))]
                              [(thing? v) (thing-state v)]
                              [else #f])))))))))))

;; Restore a game state:
(define (load-game)
  (with-filename
   (lambda (v)
     (let ([v (with-input-from-file v read)])
       (set! stuff (map name->element (car v)))
       (set! current-place (name->element (cadr v)))
       (for-each
        (lambda (p)
          (let ([v (name->element (car p))]
                [state (cdr p)])
            (cond
             [(place? v) (set-place-things! v (map name->element state))]
             [(thing? v) (set-thing-state! v state)])))
        (caddr v))))))

;; ============================================================
;; Go!
(printf "~a\n\n\n\n\n" logo)
(printf "~a\n\n" msg-inicial)

(define (executa)
  (if (andou-todos-brinquedos)
      (begin (verifica-pontos) (exit))
      (do-place)))
(executa)