#lang scheme
(require "list.ss" "graph.ss" "logger.ss")

(provide (all-defined-out))

(define max-objects 10)
(define max-nodes 1000)
(define max-edges 5000)

;; define the types of node and edge for the game

(define (make-naked-node name info objects)
  (make-node name (list info objects)))

(define (naked-node-info node)
  (list-ref (node-desc node) 0))

(define (naked-node-objects node)
  (list-ref (node-desc node) 1))

(define (make-naked-edge from to dir)
  (make-edge from to (list dir)))

(define (naked-edge-dir edge)
  (list-ref (edge-desc edge) 0))

(define (naked-add-node graph name)
  (cond 
   ((not (graph-find-node graph name))
    (log "adding node \"" name "\", size now: " 
         (+ (length (graph-nodes graph)) 1))
    (cond 
     ((< (length (graph-nodes graph)) max-nodes)
      (graph-merge 
       graph 
       (make-graph (list (make-naked-node name "" '())) '())))
     (else
      (log "too many nodes in graph! trying to add \"" name "\"")
      graph)))
   (else
    (log "node conflict with name: " name)
    graph)))

(define (naked-add-edge graph from to dir)
  (log "adding edge \"" from "\" -> \"" to "\" " dir ", size now: " 
       (+ (length (graph-edges graph)) 1))
  (cond 
   ((< (length (graph-edges graph)) max-edges)
    (graph-merge
     graph
       (make-graph '() (list (make-naked-edge from to dir)))))
   (else
    (log "too many edges in graph! trying to add \"" from "\" -> \"" to "\" " dir)
    graph)))

(define (naked-modify-node graph name modifier-proc)
  (make-graph
   (map
    (lambda (node)
      (if (string=? (node-name node) name)
          (modifier-proc node)
          node))
    (graph-nodes graph))
   (graph-edges graph)))
    
(define (naked-node-describe graph name info)
  (naked-modify-node graph name
                     (lambda (node)
                       (make-naked-node
                        (node-name node)
                        info
                        (naked-node-objects node)))))

(define (naked-node-add-object graph name object)
  (naked-modify-node graph name
                     (lambda (node)
                       (make-naked-node
                        (node-name node)
                        (naked-node-info node)
                        (safe-cons object (naked-node-objects node) max-objects
                                   (lambda ()
                                     (log "objects over limit at " name)))))))

(define (naked-node-remove-object graph name object)
  (naked-modify-node graph name
                     (lambda (node)
                       (make-naked-node
                        (node-name node)
                        (naked-node-info node)
                        (list-remove (naked-node-objects node) object)))))

(define (save-game-state graph filename)
  (log "saved state as " filename)
  (let ((f (open-output-file filename #:exists 'replace)))
    (write graph f)
    (close-output-port f)))

(define (load-game-state filename)
  (log "loaded state from " filename)
  (let* ((f (open-input-file filename))
         (g (read f)))
    (close-input-port f)
    g))