CyberChaos(さいばかおす)

プログラミング言語、トランスパイラ、RPA、ChatGPT、データマイニング、リバースエンジニアリングのための忘備録

AutoLispでテトリス!C#のコードを書き替えた。

2024-05-12 06:31:23 | Autocad

;; TetrisSquareクラスの定義
(defun TetrisSquare (x y color)
  (list x y color))

(defun TetrisSquareGetX (square)
  (nth 0 square))

(defun TetrisSquareGetY (square)
  (nth 1 square))

(defun TetrisSquareGetColor (square)
  (nth 2 square))

;; TetrisFieldクラスの定義
(defun TetrisField (/ width height squares)
  (setq width 10
        height 20
        squares (make-array (list height width))))

(defun TetrisFieldGetWidth ()
  width)

(defun TetrisFieldGetHeight ()
  height)

(defun TetrisFieldGetSquare (x y)
  (aref squares y x))

(defun TetrisFieldJudgeGameOver (block)
  (setq noEmptyCord (list)
        blockCord (list))

  (repeat height
    (repeat width
      (if (/= "gray" (TetrisSquareGetColor (TetrisFieldGetSquare x y)))
          (setq noEmptyCord (cons (cons x y) noEmptyCord)))
      (setq x (+ x 1))
      )
    (setq x 0
          y (+ y 1))
    )

  (foreach square (TetrisBlockGetSquares block)
    (setq cord (TetrisSquareGetCord square))
    (setq blockCord (cons (cons (car cord) (cadr cord)) blockCord))
    )

  (setq blockCord (vl-remove-if-not '(lambda (x) (member x noEmptyCord)) blockCord))

  (> (length blockCord) 0)
  )

(defun TetrisFieldJudgeCanMove (block direction)
  (setq noEmptyCord (list))

  (repeat height
    (repeat width
      (if (/= "gray" (TetrisSquareGetColor (TetrisFieldGetSquare x y)))
          (setq noEmptyCord (cons (cons x y) noEmptyCord)))
      (setq x (+ x 1))
      )
    (setq x 0
          y (+ y 1))
    )

  (setq moveBlockCord (list))

  (foreach square (TetrisBlockGetSquares block)
    (setq cord (TetrisSquareGetMovedCord square direction))
    (setq moveBlockCord (cons (cons (car cord) (cadr cord)) moveBlockCord))

    (if (or (< (car cord) 0)
            (>= (car cord) width)
            (< (cadr cord) 0)
            (>= (cadr cord) height))
        (return nil)
        )
    )

  (setq moveBlockCord (vl-remove-if-not '(lambda (x) (member x noEmptyCord)) moveBlockCord))

  (= (length moveBlockCord) 0)
  )

(defun TetrisFieldFixBlock (block)
  (foreach square (TetrisBlockGetSquares block)
    (setq x (car (TetrisSquareGetCord square))
          y (cadr (TetrisSquareGetCord square))
          color (TetrisSquareGetColor square))
    (setq (nth y (nth x squares)) (TetrisSquare x y color))
    )
  )

(defun TetrisFieldDeleteLine ()
  (setq y (- height 1))

  (while (>= y 0)
    (setq isFull T)

    (setq x 0)
    (while (< x width)
      (if (= "gray" (TetrisSquareGetColor (TetrisFieldGetSquare x y)))
          (setq isFull nil))
      (setq x (+ x 1))
      )

    (if isFull
        (progn
          (setq yy y)
          (while (> yy 0)
            (setq x 0)
            (while (< x width)
              (setq (nth yy (nth x squares)) (TetrisSquareGetX (nth (- yy 1) (nth x squares)))
                                              (TetrisSquareGetY (nth (- yy 1) (nth x squares)))
                                              (TetrisSquareGetColor (nth (- yy 1) (nth x squares)))))
              (setq x (+ x 1))
              )
            (setq yy (- yy 1))
            )

          (setq x 0)
          (while (< x width)
            (setq (nth 0 (nth x squares)) (TetrisSquare x 0 "gray"))
            (setq x (+ x 1))
            )

          (setq y (+ y 1))
          )
        )

    (setq y (- y 1))
    )
  )

;; TetrisBlockクラスの定義
(defun TetrisBlock (/ squares)
  (setq squares (list))

  (setq blockType (random 4))

  (cond
    ((= blockType 0)
     (setq color "red"
           cords (list (list (/ 10 2) 0)
                       (list (/ 10 2) 1)
                       (list (/ 10 2) 2)
                       (list (/ 10 2) 3))))
    ((= blockType 1)
     (setq color "blue"
           cords (list (list (/ 10 2) 0)
                       (list (/ 10 2) 1)
                       (list (- (/ 10 2) 1) 0)
                       (list (- (/ 10 2) 1) 1))))
    ((= blockType 2)
     (setq color "green"
           cords (list (list (- (/ 10 2) 1) 0)
                       (list (/ 10 2) 0)
                       (list (/ 10 2) 1)
                       (list (/ 10 2) 2))))
    ((= blockType 3)
     (setq color "orange"
           cords (list (list (/ 10 2) 0)
                       (list (- (/ 10 2) 1) 0)
                       (list (- (/ 10 2) 1) 1)
                       (list (- (/ 10 2) 1) 2))))
    (T
     (setq color "gray"
           cords nil))
    )

  (foreach cord cords
    (setq squares (cons (TetrisSquare (car cord) (cadr cord) color) squares))
    )

  squares
  )

(defun TetrisBlockGetSquares (block)
  squares)

(defun TetrisBlockMove (block direction)
  (setq newSquares (list))

  (foreach square squares
    (setq movedCord (TetrisSquareGetMovedCord square direction)
          x (car movedCord)
          y (cadr movedCord))
    (setq newSquares (cons (TetrisSquare x y (TetrisSquareGetColor square)) newSquares))
    )

  (setq squares newSquares)
  )

;; TetrisGameクラスの定義
(defun TetrisGame (/ field block canvas)
  (setq field (TetrisField)
        block nil
        canvas nil))

(defun TetrisGameStart ()
  (setq field (TetrisField)
        block nil
        canvas (TetrisCanvas field))
  )

(defun TetrisGameNewBlock ()
  (setq block (TetrisBlock))

  (if (TetrisFieldJudgeGameOver block)
      (progn
        (princ "GAMEOVER")
        (terpri))
      )

  )

(defun TetrisGameMoveBlock (direction)
  (if (TetrisFieldJudgeCanMove block direction)
      (progn
        (TetrisBlockMove block direction)
        (TetrisCanvasUpdate canvas field block))
    (if (= direction 2)
        (progn
          (TetrisFieldFixBlock block)
          (TetrisFieldDeleteLine)
          (TetrisGameNewBlock)
          (TetrisCanvasUpdate canvas field block))
      )
    )
  )

;; TetrisCanvasクラスの定義
(defun TetrisCanvas (field)
  (setq beforeField field
        field field))

(defun TetrisCanvasUpdate (field block)
  (setq beforeField field)

  ;; キャンバスを更新する処理
  )

;; TetrisCommandsクラスの定義
(defun c:TETRIS ()
  (setq field (TetrisField)
        block nil
        canvas (TetrisCanvas field)
        game (TetrisGame))

  (TetrisGameStart)

  (while T
    ;; ユーザー入力を取得し、適切な方向で game.MoveBlock(direction) を呼び出す
    )
  )

さてどうなるか?



最新の画像もっと見る

コメントを投稿

ブログ作成者から承認されるまでコメントは反映されません。