;; Framework for the CS 3 "Blocks World" project.

; This file contains procedures to initialize the blocks world, to read
; commands from the user, and to display a graphic version of the blocks
; world.

; Initialize the blocks environment from a file specified by the user.
; Handle all the user's commands, then come back and put the updated
; blocks configuration in a file named "blocks.out".

(define (startup)
  (display '(type the name of the blocks configuration file surrounded by double quotes))
  (newline)
  (let*
    ((final-blocks (handle-cmds (read (open-input-file (read))) '()) )
     (new-blocks-file (open-output-file "blocks.out") ) )
    (display final-blocks new-blocks-file)
    (newline new-blocks-file) ) )

; Handle commands until a "quit" command is submitted.
; blocks is a blocks configuration; it is a list of blocks.
; If it contains only one block, a reference to "it" is unambiguous.
(define (handle-cmds blocks it)
  (display (append '(block configuration =) (list blocks)))
  (newline)
  (draw-stack-list blocks)      ; Call graphics display code.
  (display "command? ")
  (let ((cmd (read)))
    (cond
      ((equal? cmd '(quit))
       (display (append '(final configuration =) (list blocks)))
       (newline)
       blocks)
      (else
       (let ((analyzed-cmd (analyzed cmd blocks it)))
         (if analyzed-cmd
             (execute analyzed-cmd blocks it)
             (handle-cmds blocks '()) ) ) ) ) ) )

  ; Constants for displaying blocks.
; BLOCK-SIZE is the height and width in pixels of each block.
; FUDGE is the number of pixels that separate adjacent stacks.
(define BLOCK-SIZE 50)
(define FUDGE 5)

; Access functions for block information.
(define block-id first)
(define block-color second)
                    
;; Graphics procedure overview.

; These routines rely on the turtle graphics routines loaded in berkeley.scm.
; At each call to draw the blocks world, we clear the screen, hide the turtle,
; and commence drawing stacks of blocks.
; The base line for the bottom blocks is the height of the window minus 200 pixel s.
; Each stack is drawn from bottom to top, and the stacks are drawn from left
; to right.  In the X window system, x coordinates increase going from left to
; right, and y coordinates increase going from top to bottom.

; Create a window and display a blocks environment, a list of stacks.
(define (draw-stack-list stack-list)
  (clearscreen)
  (hideturtle)
  (draw-stack-list-helper
    stack-list 
    FUDGE
    (+ (canvas-height) -200 FUDGE)) )

; Display a list of stacks, with the lower-left corner of the bottom block
; in the first stack at position (x,y). 
(define (draw-stack-list-helper stack-list x y)
  (cond 
    ((null? stack-list) 'DONE)
    (else 
      (draw-stack (reverse (first stack-list)) x y)
      (draw-stack-list-helper 
        (rest stack-list)
        (+ x BLOCK-SIZE FUDGE) y) ) ) )

; Display a stack, with the lower-left corner of the bottom block at position 
; (x,y).  The first block on the stack is its *bottom* block; this is the
; opposite of how blocks are stored in a blocks environment.
(define (draw-stack stack x y)
  (cond
    ((null? stack) 'DONE)
    (else
      (draw-block (first stack) x y)
      (draw-stack (rest stack) x (- y BLOCK-SIZE FUDGE)) ) ) )

; Display a block with lower-left corner at position (x,y).
; Its block id number will be printed in the middle of the block.
(define (draw-block block x y)
  (canvas-widget 
    'create 'rect
    x (- y BLOCK-SIZE) (+ x BLOCK-SIZE) y 
    :fill (block-color block) )                 ; draw the block
  (let ((name-incr (- (truncate (/ BLOCK-SIZE 2)) FUDGE)))
    (canvas-widget
      'create 'text
      (+ x name-incr) (- y name-incr)
      :text (number->string (block-id block))
      :fill 'black
      :anchor 'sw) ) )                  ; draw the identifying number