;;仓库世家游戏
(defun c:yad_box(/ comp check_val dis+- preview do_- do_level do_+ do_back do_test do_add do_erase do_move do_save do_load do_help
                   dcl_id a b level total time move l_wall l_box l_site l_man wall_l box_l site_l man_l wall_ll box_ll site_ll man_ll old_man old_box dis name test)
  (defun comp(lst1 lst2)
    (foreach n lst1
      (setq lst2 (vl-remove n lst2))
    )
    (if lst2 nil T)
  )
  (defun check_val(title maxint minint oldval / val)
    (setq val (atoi (get_tile title)))
    (if (>= maxint val minint)
      (set_tile title (itoa val))
      (set_tile title oldval)
    )
  )
  (defun dis+-(/ x a b)
    (setq x (dimx_tile "y_-"))
    (setq a (- x 6) b 2)
    (start_image "y_-")
    (fill_image 3 (1- (/ x 2)) a b 41)
    (end_image)
    (setq x (dimx_tile "y_+") y (dimy_tile "y_+"))
    (start_image "y_+")
    (fill_image 3 (1- (/ x 2)) a b 41)
    (fill_image (1- (/ x 2)) 3 b a 41)
    (end_image)
  )
  (defun preview (/ n)
    (start_image "y_img")
    (fill_image 0 0 a b 168)
    (foreach n (mapcar '(lambda(e) (list (* dis (1- (car e))) (* dis (1- (cadr e))) dis dis)) l_wall)
      (fill_image (nth 0 n) (nth 1 n) (nth 2 n) (nth 3 n) 41)
    )
    (foreach n (mapcar '(lambda(e) (list (+ 1 (* dis (1- (car e)))) (+ 1 (* dis (1- (cadr e)))) (- dis 2) (- dis 2))) l_site)
      (fill_image (nth 0 n) (nth 1 n) (nth 2 n) (nth 3 n) 3)
    )
    (foreach n (mapcar '(lambda(e) (list (+ 2 (* dis (1- (car e)))) (+ 2 (* dis (1- (cadr e)))) (- dis 4) (- dis 4))) l_box)
      (fill_image (nth 0 n) (nth 1 n) (nth 2 n) (nth 3 n) (if (member n (mapcar '(lambda(e) (list (+ 2 (* dis (1- (car e)))) (+ 2 (* dis (1- (cadr e)))) (- dis 4) (- dis 4))) l_site)) 6 4))
    )
    (foreach n (mapcar '(lambda(e) (list (+ 2 (* dis (1- (car e)))) (+ 2 (* dis (1- (cadr e)))) (- dis 4) (- dis 4))) l_man)
      (fill_image (nth 0 n) (nth 1 n) (nth 2 n) (nth 3 n) 1)
    )
    (end_image)
  )
  (defun do_-()
    (if (> level 1)
      (progn
        (do_level (setq level (1- level)))
        (set_tile "y_level" (itoa level))
        (preview)
      )
    )
  )
  (defun do_+()
    (if (< level total)
      (progn
        (do_level (setq level (1+ level)))
        (set_tile "y_level" (itoa level))
        (preview)
      )
    )
  )
  (defun do_level(val)
    (setq fr (open (findfile "box.dat") "r"))
    (setq total (cadr (read (read-line fr))))
    (repeat (+ 4 (* 5 (1- val))) (read-line fr))
    (setq name (read-line fr))
    (setq l_wall (read (read-line fr)))
    (setq l_box (read (read-line fr)))
    (setq l_site (read (read-line fr)))
    (setq l_man (read (read-line fr)))
    (close fr)
    (setq time 0 move 0)
    (set_tile "y_total" (itoa total))
    (set_tile "y_time" "0")
    (set_tile "y_move" "0")
    (set_tile "y_err" (strcat "本关游戏由" (if (wcmatch name "level*") "系统" (strcat "网友" name)) "提供！"))
    (mode_tile "y_back" 1)
    (setq old_box nil)
  )
  (defun do_back()
    (mode_tile "y_back" 1)
    (setq l_man old_man)
    (if old_box
      (progn
        (setq l_box old_box time (1- time))
        (set_tile "y_time" (itoa time))
      )
      (progn
        (setq move (1- move))
        (set_tile "y_move" (itoa move))
      )
    )
    (preview)
  )
  (defun do_test()
    (if (/= (length l_box) (length l_site))
      (set_tile "y_err" "箱子和地点数量不相等！")
      (progn
        (setq test T)
        (setq wall_ll l_wall box_ll l_box site_ll l_site man_ll l_man)
        (done_dialog)
        (set_tile "y_err" (if test "正在测试你设计的游戏！" "123"))
        (mode_tile "y_back" 1)
        (mode_tile "y_level1" 1)
        (mode_tile "y_reset" 1)
        (mode_tile "y_erase" 1)
        (mode_tile "y_save" 1)
        (mode_tile "y_load" 1)
        (setq old_box nil)
        (preview)
      )
    )
  )
  (defun do_add(/ do_ok do_help style)
    (defun do_img(x y / lst)
      (setq lst (list (1+ (/ x dis)) (1+ (/ y dis))))
      (cond
        ((= style 1)
          (if (not (or (member lst l_box) (member lst l_site) (member lst l_man)))
            (if (member lst l_wall)
              (setq l_wall (vl-remove lst l_wall))
              (setq l_wall (append l_wall (list lst)))
            )
          )
        )
        ((= style 2)
          (if (not (or (member lst l_wall) (member lst l_man)))
            (if (member lst l_box)
              (setq l_box (vl-remove lst l_box))
              (setq l_box (append l_box (list lst)))
            )
          )
        )
        ((= style 3)
          (if (not (member lst l_wall))
            (if (member lst l_site)
              (setq l_site (vl-remove lst l_site))
              (setq l_site (append l_site (list lst)))
            )
          )
        )
        ((= style 4)
          (if (not (or (member lst l_wall) (member lst l_box)))
            (setq l_man (list lst))
          )
        )
      )
      (preview)
    )
    (defun do_help()
      (alert (strcat "\n　　　　游戏设计说明　　　　　\n\n"
                     "用鼠标直接在界面上布置设计元素\n\n"
                     "用鼠标直接点取元素来删除该元素\n\n"
                     "箱子元素和地点元素的数量要相等\n\n"
                     "姓名：输入姓名表示本关游戏由你提供\n\n"
                     "墙体：用来布置墙体元素\n\n"
                     "箱子：用来布置箱子元素\n\n"
                     "地点：用来布置地点元素\n\n"
                     "工人：用来布置工人元素\n\n"
                     "　　林育游 lyy.xm@163.com"
             )
      )
    )
    (defun do_ok(/ dat str1 str)
      (setq name (get_tile "y_name"))
      (cond
        ((= name "") (set_tile "y_err" "请输入你的姓名！"))
        ((/= (length l_box) (length l_site)) (set_tile "y_err" "箱子和地点数量不相等！"))
        (T
          (setq dat (findfile "box.dat"))
          (setq total (1+ total) level total time 0 move 0)
          (setq fr (open dat "r"))
          (setq fw (open (strcat dat "new") "w"))
          (setq str1 (read (read-line fr)))
          (prin1 (list (car str1) total (caddr str1) (cadddr str1) (last str1)) fw)
          (princ "\n" fw)
          (while (setq str (read-line fr))
            (write-line str fw)
          )
          (princ (strcat name "\n") fw)
          (prin1 l_wall fw)
          (princ "\n" fw)
          (prin1 l_box fw)
          (princ "\n" fw)
          (prin1 l_site fw)
          (princ "\n" fw)
          (prin1 l_man fw)
          (princ "\n" fw)
          (close fr)
          (close fw)
          (vl-file-delete dat)
          (vl-file-rename (strcat dat "new") dat)
          (done_dialog)
          (set_tile "y_level" (itoa level))
          (set_tile "y_total" (itoa total))
          (set_tile "y_time" (itoa time))
          (set_tile "y_move" (itoa move))
          (set_tile "y_err" (strcat "本关游戏由网友" name "提供！"))
          (mode_tile "y_back" 1)
          (setq old_box nil)
          (preview)
          (setq test nil)
        )
      )
    )
    (mode_tile "y_level1" 0)
    (mode_tile "y_reset" 0)
    (mode_tile "y_erase" 0)
    (mode_tile "y_save" 0)
    (mode_tile "y_load" 0)
    (if test
      (setq l_wall wall_ll l_box box_ll l_site site_ll l_man man_ll)
      (setq wall_l l_wall box_l l_box site_l l_site man_l l_man)
    )
    (if (not (new_dialog "edit" dcl_id)) (exit))
    (preview)
    (setq style 1)
    (set_tile "y_name" "yad")
    (set_tile "y_err" "欢迎使用游戏设计程序！")
    (action_tile "y_img" "(do_img $x $y)")
    (action_tile "y_wall" "(setq style 1)")
    (action_tile "y_box" "(setq style 2)")
    (action_tile "y_site" "(setq style 3)")
    (action_tile "y_man" "(setq style 4)")
    (action_tile "test" "(do_test)")
    (action_tile "accept" "(do_ok)")
    (action_tile "cancel" "(setq l_wall wall_l l_box box_l l_site site_l l_man man_l)(done_dialog)
                           (if test
                             (progn
                               (preview)
                               (set_tile \"y_err\" (strcat \"本关游戏由\" (if (wcmatch name \"level*\") \"系统\" (strcat \"网友\" name)) \"提供！\"))
                             )
                           )
                           (setq test nil)")
    (action_tile "y_help" "(do_help)")
    (start_dialog)
  )
  (defun do_erase(/ yy dat str1 str l_str0)
    (if (> level 452)
      (progn
        (if (not (new_dialog "boxalert" dcl_id)) (exit))
        (action_tile "accept" "(done_dialog 1)")
        (action_tile "cancel" "(done_dialog 0)")
        (setq yy (start_dialog))
        (if (= yy 1)
          (progn
            (setq dat (findfile "box.dat"))
            (setq fr (open dat "r"))
            (setq fw (open (strcat dat "new") "w"))
            (setq str1 (read (read-line fr)))
            (if (= name (last str1))
              (progn
                (setq str1 (list 1 (setq total (1- total)) 0 0 "level　1"))
                (prin1 str1 fw)
                (princ "\n" fw)
                (repeat 4 (read-line fr))
                (repeat 5
                  (setq str (read-line fr))
                  (setq l_str0 (append l_str0 (list str)))
                )
                (foreach n (cdr l_str0)
                  (write-line n fw)
                )
                (foreach n l_str0
                  (write-line n fw)
                )
                (repeat (* 5 (- level 2))
                  (setq str (read-line fr))
                  (write-line str fw)
                )
              )
              (progn
                (setq str1 (list (car str1) (setq total (1- total)) (caddr str1) (cadddr str1) (last str1)))
                (prin1 str1 fw)
                (princ "\n" fw)
                (repeat 4
                  (setq str (read-line fr))
                  (write-line str fw)
                )

                (repeat (* 5 (1- level))
                  (setq str (read-line fr))
                  (write-line str fw)
                )
              )
            )
            (repeat 5 (read-line fr))
            (while (setq str (read-line fr))
              (write-line str fw)
            )
            (close fr)
            (close fw)
            (vl-file-delete dat)
            (vl-file-rename (strcat dat "new") dat)
            (setq level 1)
            (do_level level)
            (preview)
            (set_tile "y_level" "1")
          )
        )
      )
      (alert "不能删除系统的游戏等级！")
    )
  )
  (defun do_move (val / oldman oldbox x y)
    (setq oldman l_man x (caar l_man) y (cadar l_man))
    (cond
      ((= val 8) (setq y (1- y)))
      ((= val 5) (setq y (1+ y )))
      ((= val 4) (setq x (1- x)))
      ((= val 6) (setq x (1+ x)))
    )
    (setq l_man (list (list x y)))
    (cond
      ((or (member (car l_man) l_wall) (= (caar l_man) 0) (= (caar l_man) 22) (= (cadar l_man) 0) (= (cadar l_man) 22))
        (setq l_man oldman)
      )
      ((member (car l_man) l_box)
        (setq oldbox l_box x (caar l_man) y (cadar l_man))
        (cond
          ((= val 8) (setq y (1- y)))
          ((= val 5) (setq y (1+ y )))
          ((= val 4) (setq x (1- x)))
          ((= val 6) (setq x (1+ x)))
        )
        (if (or (member (list x y) l_wall) (member (list x y) l_box))
          (setq l_man oldman)
          (progn
            (setq l_box (subst (list x y) (car l_man) l_box))
            (if (not test) (setq time (1+ time)))
            (set_tile "y_time" (itoa time))
            (mode_tile "y_back" 0)
            (preview)
            (setq old_man oldman old_box oldbox)
            (if (and (member (list x y) l_site) (comp l_box l_site) (not test))
              (progn
                (setq level (1+ level))
                (if (> level total) (setq level 1))
                (do_level level)
                (preview)
                (set_tile "y_level" (itoa level))
              )
            )
          )
        )
      )
      (T
        (if (not test) (setq move (1+ move)))
        (set_tile "y_move" (itoa move))
        (mode_tile "y_back" 0)
        (preview)
        (setq old_man oldman old_box nil)
      )
    )
  )
  (defun do_save(/ dat str)
    (setq dat (findfile "box.dat"))
    (setq fr (open dat "r"))
    (repeat 5 (read-line fr))
    (setq fw (open (strcat dat "new") "w"))
    (prin1 (list level total time move name) fw)
    (princ "\n" fw)
    (prin1 l_wall fw)
    (princ "\n" fw)
    (prin1 l_box fw)
    (princ "\n" fw)
    (prin1 l_site fw)
    (princ "\n" fw)
    (prin1 l_man fw)
    (princ "\n" fw)
    (while (setq str (read-line fr))
      (write-line str fw)
    )
    (close fr)
    (close fw)
    (vl-file-delete dat)
    (vl-file-rename (strcat dat "new") dat)
    (alert "当前的游戏位置已保存！")
  )
  (defun do_load()
    (setq fr (open (findfile "box.dat") "r"))
    (setq total (read (read-line fr)))
    (setq l_wall (read (read-line fr)))
    (setq l_box (read (read-line fr)))
    (setq l_site (read (read-line fr)))
    (setq l_man (read (read-line fr)))
    (setq level (car total) time (caddr total) move (cadddr total) name (last total) total (cadr total))
    (close fr)
    (set_tile "y_level" (itoa level))
    (set_tile "y_total" (itoa total))
    (set_tile "y_time" (itoa time))
    (set_tile "y_move" (itoa move))
    (set_tile "y_err" (strcat "本关游戏由" (if (wcmatch name "level*") "系统" (strcat "网友" name)) "提供！"))
    (mode_tile "y_back" 1)
    (setq old_box nil)
    (preview)
  )
  (defun do_help()
    (alert (strcat "\n　　　　　　游戏使用说明　　　　　　　\n\n"
                   "把蓝色方块全部推到绿色方块的位置去\n\n"
                   "可用小键盘的４５６８键控制移动方向\n\n"
                   "保存：保存当前的游戏位置\n\n"
                   "加载：加载已保存的游戏位置继续游戏\n\n"
                   "等级：输入直接进入游戏的等级\n\n"
                   "＋－：前进或后退一个等级\n\n"
                   "等级总数：显示游戏的等级总数\n\n"
                   "推箱次数：显示红色方块推动蓝色箱子的次数\n\n"
                   "移动次数：显示红色方块没推箱子的移动次数\n\n"
                   "重新开始：重新开始目前等级的游戏\n\n"
                   "返回一步：返回一步，只能一步\n\n"
                   "增加等级：自己设计增加某个游戏等级\n\n"
                   "删除等级：只能删除自己增加的游戏等级\n\n"
                   "上下左右：控制红色方块上下左右的移动方向\n\n"
                   "　　　　林育游 lyy.xm@163.com"
           )
    )
  )
  (if (findfile "box.dat")
    (progn
      (setq dcl_id (load_dialog "box.dcl"))
      (if (not (new_dialog "box" dcl_id)) (exit))
      (setq a (dimx_tile "y_img") b (dimy_tile "y_img"))
      (setq dis (/ a 21))
      (setq level 1)
      (do_level level)
      (preview)
      (set_tile "y_level" "1")
      (mode_tile "y_up" 2)
      (dis+-)
      (action_tile "y_level" "(check_val \"y_level\" total 1 (itoa level)) (do_level (setq level (atoi (get_tile \"y_level\")))) (preview) (mode_tile \"y_up\" 2)")
      (action_tile "y_-" "(do_-)")
      (action_tile "y_reset" "(do_level level) (preview)")
      (action_tile "y_+" "(do_+)")
      (action_tile "y_back" "(do_back)")
      (action_tile "y_add" "(do_add)")
      (action_tile "y_erase" "(do_erase)")
      (action_tile "y_up" "(do_move 8)")
      (action_tile "y_down" "(do_move 5)")
      (action_tile "y_left" "(do_move 4)")
      (action_tile "y_right" "(do_move 6)")
      (action_tile "y_save" "(do_save)")
      (action_tile "y_load" "(do_load)")
      (action_tile "cancel" "(done_dialog)")
      (action_tile "y_help" "(do_help)")
      (start_dialog)
      (unload_dialog dcl_id)
    )
    (prompt "\n没有找到游戏数据box.dat文件！")
  )
  (princ)
)
(prompt "\n*** 仓库世家游戏yad_box ***   YAD建筑")
(princ)