fork download
  1. ;; //ideone.com/vzncKq
  2. ;; //ideone.com/B76Dki
  3.  
  4. (defstruct point x y)
  5.  
  6. (defun point+ (p q)
  7. (make-point :x (+ (point-x p) (point-x q))
  8. :y (+ (point-y p) (point-y q))))
  9.  
  10. (defun make-point-from-char (c)
  11. (ecase c
  12. (#\> (make-point :x 1 :y 0))
  13. (#\v (make-point :x 0 :y 1))
  14. (#\< (make-point :x -1 :y 0))
  15. (#\^ (make-point :x 0 :y -1))))
  16.  
  17. (defun draw (chars &key start-char end-char (space-char #\*))
  18. (loop with scr = (make-hash-table :test #'equalp)
  19. with start = (make-point :x 0 :y 0)
  20.  
  21. for c across chars
  22. for p = start then (point+ p (make-point-from-char c))
  23. for end = start then p
  24.  
  25. minimize (point-x p) into min-x
  26. minimize (point-y p) into min-y
  27. maximize (point-x p) into max-x
  28. maximize (point-y p) into max-y
  29.  
  30. do (setf (gethash p scr) c)
  31.  
  32. finally (when start-char (setf (gethash start scr) start-char))
  33. (when end-char (setf (gethash end scr) end-char))
  34. (loop for y from min-y upto max-y
  35. do (loop for x from min-x upto max-x
  36. for c = (gethash (make-point :x x :y y) scr)
  37. do (princ (or c space-char)))
  38. (terpri))))
  39.  
  40. (loop while (listen)
  41. do (draw (read-line) :start-char #\A
  42. :end-char #\Z
  43. :space-char #\Space)
  44. do (terpri))
  45.  
Success #stdin #stdout 0s 203840KB
stdin
>>>>>vvvvv<<<<^^^^
<<<<^^^^>>>>>vv<<<<<<<<<<<vvv>>>^^^^^^^>>>>>>>>>>vvvvvv
^^<<<vvv>>>>>>^^^^^<<<<<<<<<vvvvvvv>>>>>>>>>>>>^^^^^^^^^<<<<<<<<<<<<<<<vvvvvvvvvvv>>>>>>>>>>>>>>>>>>^^^^^^^^^^^
stdout
A>>>>
Z   v
^   v
^   v
^   v
<<<<v

   ^>>>>>>>>>>
   ^         v
   ^  ^>>>>> v
   ^  ^    v v
<<<^<<<<<<<v v
v  ^  ^      v
v  ^  <<<A   Z
v>>>          

<<<<<<<<<<<<<<<^  Z
v              ^  ^
v  <<<<<<<<<^  ^  ^
v  v        ^  ^  ^
v  v  <<<^  ^  ^  ^
v  v  v  A  ^  ^  ^
v  v  v     ^  ^  ^
v  v  v>>>>>>  ^  ^
v  v           ^  ^
v  v>>>>>>>>>>>>  ^
v                 ^
v>>>>>>>>>>>>>>>>>>