<commit_before>;;;; Orbsim
;; Menu functions

(ql:quickload 'ltk)

(defun remove-nth (n list)
  (if (or (zerop n) (null list))
      (cdr list)
      (cons (car list) (remove-nth (1- n) (cdr list)))))

(defun error-message (message)
  (ltk:with-ltk ()
    (let ((label (make-instance 'ltk:label 
				:text message))
	  (button (make-instance 'ltk:button 
				 :text "OK"
				 :command (lambda ()
					    (setf ltk:*break-mainloop* t)))))
      (ltk:pack label)
      (ltk:pack button)
      (ltk:mainloop))))

(defun parse-int (str)
  (let ((int (parse-integer str :junk-allowed 't)))
    (if int
	int
	(error-message "Please Enter a valid integer"))))

(defun listbox-update (listbox)
  (ltk:listbox-clear listbox)
  (ltk:listbox-append listbox (cdr (mapcar #'id *bodies*))))

(defun menu ()
  (ltk:with-ltk ()
    (let* ((exit (make-instance 'ltk:button
				:master nil
				:text "exit"
				:command (lambda () 
					   (setf *quit* 't)
					   (setf ltk:*exit-mainloop* 't))))
	   (frame (make-instance 'ltk:frame ; for add body
				 :master nil))
	   (frame2 (make-instance 'ltk:frame ; for remove body
				  :master nil))
	   (frame3 (make-instance 'ltk:frame ; for save system
				  :master nil))
	   (bod-list (make-instance 'ltk:listbox
				    :master frame2))
	   (label-ad (make-instance 'ltk:label
				    :master frame
				    :text "Add body"
				    :anchor :n))
	   (in-posx (make-instance 'ltk:entry
				   :master frame
				   :text "0"))
	   (in-posy (make-instance 'ltk:entry
				   :master frame
				   :text "100000000"))
	   (in-velx (make-instance 'ltk:entry
				   :master frame
				   :text "1000000"))
	   (in-vely (make-instance 'ltk:entry
				   :master frame
				   :text "0"))
	   (in-size (make-instance 'ltk:entry
				   :master frame
				   :text "2"))
	   (in-id (make-instance 'ltk:entry
				 :master frame
				 :text "nil"))
	   (label-px (make-instance 'ltk:label
				    :master frame
				    :text "pos-x"))
	   (label-py (make-instance 'ltk:label
				    :master frame
				    :text "pos-y"))
	   (label-vx (make-instance 'ltk:label
				    :master frame
				    :text "vel-x"))
	   (label-vy (make-instance 'ltk:label
				    :master frame
				    :text "vel-y"))
	   (label-sz (make-instance 'ltk:label
				    :master frame
				    :text "size"))
	   (label-id (make-instance 'ltk:label
				    :master frame
				    :text "id"))
	   (sub (make-instance
		 'ltk:button :master frame :text "submit"
		 :command (lambda ()
			    (apply #'add-body
				   (append
				    (mapcar #'parse-int
					    (list
					     (ltk:text in-posx)
					     (ltk:text in-posy)
					     (ltk:text in-velx)
					     (ltk:text in-vely)))
				    (list :size (parse-int (ltk:text in-size))
					  :id (ltk:text in-id)
					  :colour 'a)))
			    (listbox-update bod-list))))
	   (label-rm (make-instance 'ltk:label
				    :master frame2
				    :text "Remove Body"))
	   (rm (make-instance 'ltk:button
			      :master frame2
			      :text "remove"
			      :command (lambda ()
					 (setf 
					  *bodies*
					  (remove-nth 
					   (1+ 
					    (car 
					     (ltk:listbox-get-selection 
					      bod-list)))
					   *bodies*))
					 (listbox-update bod-list))))
	   (in-fn (make-instance 'ltk:entry ;filename input
				 :master frame3
				 :text "bodies.txt"))
	   (save (make-instance 'ltk:button
				:master frame3
				:text "Save"
				:command (save-bodies (ltk:text in-fn))))
	   (load (make-instance 'ltk:button
				:master frame3
				:text "Load"
				:command (read-bodies (ltk:text in-fn)))))
    (progn
      (ltk:grid exit 4 1 :padx 3 :pady 3)
      (ltk:grid sub 7 1 :padx 3 :pady 3)
      (ltk:grid in-posx 1 2 :padx 3 :pady 3)
      (ltk:grid in-posy 2 2 :padx 3 :pady 3)
      (ltk:grid in-velx 3 2 :padx 3 :pady 3)
      (ltk:grid in-vely 4 2 :padx 3 :pady 3)
      (ltk:grid in-size 5 2 :padx 3 :pady 3)
      (ltk:grid in-id 6 2 :padx 3 :pady 3)
      (ltk:grid label-px 1 1)
      (ltk:grid label-py 2 1)
      (ltk:grid label-vx 3 1)
      (ltk:grid label-vy 4 1)
      (ltk:grid label-sz 5 1)
      (ltk:grid label-id 6 1)
      (ltk:grid frame 1 1)
      
      (ltk:listbox-append bod-list (cdr (mapcar #'id *bodies*)))
      (ltk:grid label-rm 1 1)
      (ltk:grid rm 2 1)      
      (ltk:grid bod-list 2 2)
      (ltk:grid frame2 2 1)
      
      (ltk:grid in-fn 1 1 :padx 3 :pady 3)
      (ltk:grid save 2 1 :padx 3 :pady 3)
      (ltk:grid load 2 2 :padx 3 :pady 3)
      (ltk:grid frame3 3 1)
      (ltk:mainloop)))))
<commit_msg>comments in menu.lisp<commit_after>;;;; Orbsim
;; Menu functions

; Load required libraries
(ql:quickload 'ltk)

(defun remove-nth (n list)
  "Removes the nth items from a list"
  (if (or (zerop n) (null list))
      (cdr list)
      (cons (car list) (remove-nth (1- n) (cdr list)))))

(defun error-message (message &optional (button-text "OK"))
  "Makes a box appear with the message given"
  (ltk:with-ltk ()
    (let (; Label that displays the message
	  (label (make-instance 'ltk:label 
				:text message))
	  ; Button that displays the text given, or OK if none is given
	  (button (make-instance 'ltk:button 
				 :text button-text
				 :command (lambda ()
					    (setf ltk:*break-mainloop* t)))))
      ; Place the items into the window
      (ltk:pack label)
      (ltk:pack button)
      (ltk:mainloop))))

(defun parse-int (str)
  "Converts a string to an int, and creates an error message if its invalid"
  (let ((int (parse-integer str :junk-allowed 't)))
    ; If parse-integer returns a value, return it, if not create an error message
    (if int
	int
	(error-message "Please Enter a valid integer"))))

(defun listbox-update (listbox)
  "Updates the listbox in remove body"
  (ltk:listbox-clear listbox)
  (ltk:listbox-append listbox 
		      ; The list of body ids, execpt for the first
		      ; (we don't want anyone removing the sun)
		      (cdr (mapcar #'id *bodies*))))

(defun menu ()
  (ltk:with-ltk ()
    (let* (; Exit button
	   (exit (make-instance 'ltk:button
				:master nil
				:text "exit"
				:command (lambda () 
					   (setf *quit* 't)
					   (setf ltk:*exit-mainloop* 't))))
	   ; Frame for add body
	   (frame (make-instance 'ltk:frame 
				 :master nil))
	   ; Frame for remove body
	   (frame2 (make-instance 'ltk:frame 
				  :master nil))
	   ; Frame for save system
	   (frame3 (make-instance 'ltk:frame 
				  :master nil))
	   ; List box for remove body
	   (bod-list (make-instance 'ltk:listbox
				    :master frame2))
	   ; Label for add body
	   (label-ad (make-instance 'ltk:label
				    :master frame
				    :text "Add body"
				    :anchor :n))
	   ; Entry for X pos in add body
	   (in-posx (make-instance 'ltk:entry
				   :master frame
				   :text "0"))
	   ; Entry for Y pos in add body
	   (in-posy (make-instance 'ltk:entry
				   :master frame
				   :text "100000000"))
	   ; Entry for X vel in add body
	   (in-velx (make-instance 'ltk:entry
				   :master frame
				   :text "1000000"))
	   ; Entry for Y vel in add body
	   (in-vely (make-instance 'ltk:entry
				   :master frame
				   :text "0"))
	   ; Entry for size in add body
	   (in-size (make-instance 'ltk:entry
				   :master frame
				   :text "2"))
	   ; Entry for id in add body
	   (in-id (make-instance 'ltk:entry
				 :master frame
				 :text "nil"))
	   ; Label for X pos in add body
	   (label-px (make-instance 'ltk:label
				    :master frame
				    :text "pos-x"))
	   ; Label for Y pos in add body
	   (label-py (make-instance 'ltk:label
				    :master frame
				    :text "pos-y"))
	   ; Label for X vel in add body
	   (label-vx (make-instance 'ltk:label
				    :master frame
				    :text "vel-x"))
	   ; Label for Y vel in add body
	   (label-vy (make-instance 'ltk:label
				    :master frame
				    :text "vel-y"))
	   ; Label for size in add body
	   (label-sz (make-instance 'ltk:label
				    :master frame
				    :text "size"))
	   ; Label for id in add body
	   (label-id (make-instance 'ltk:label
				    :master frame
				    :text "id"))
	   ; Submit button for add body
	   (sub (make-instance
		 'ltk:button :master frame :text "submit" :command 
		 ; Function called when button is pressed
		 (lambda ()
		   ; Calls add body with the arguments in the list given
		   (apply #'add-body
			  ; Creates one list from multiple
			  (append
			   ; Calls parse-int on all of the items in the list given
			   (mapcar #'parse-int
				   ; Creates list of values given
				   (list
				    (ltk:text in-posx)
				    (ltk:text in-posy)
				    (ltk:text in-velx)
				    (ltk:text in-vely)))
			   ; Creates list of size, id and colour
			   (list :size (parse-int (ltk:text in-size))
				 :id (ltk:text in-id)
				 :colour 'a)))
		   ; Updates the listbox in remove body
		   (listbox-update bod-list))))
	   ; Label for remove body
	   (label-rm (make-instance 'ltk:label
				    :master frame2
				    :text "Remove Body"))
	   ; Remove button for remove body
	   (rm (make-instance 'ltk:button
			      :master frame2
			      :text "remove" :command 
			      ;Function called when button pressed
			      (lambda ()
				; Set bodies to:
				(setf *bodies*
				 ; Remove nth item from body
				 (remove-nth 
				  (1+ 
				   (car 
				    ; Selection in listbox
				    (ltk:listbox-get-selection 
				     bod-list)))
				  *bodies*))
				; Updates the list box
				(listbox-update bod-list))))
	   ; Entry for file name input in save system
	   (in-fn (make-instance 'ltk:entry 
				 :master frame3
				 :text "bodies.txt"))
	   ; Button to save in save system
	   (save (make-instance 'ltk:button
				:master frame3
				:text "Save"
				; Calls save-bodies with the file name given
				:command (lambda () (save-bodies (ltk:text in-fn)))))
	   ; Button to load in save system
	   (load (make-instance 'ltk:button
				:master frame3
				:text "Load"
				; Calls read-bodies with the file name given
				:command (lambda () (read-bodies (ltk:text in-fn))))))
    (progn
      ; Puts the add body items into the window
      (ltk:grid sub 7 1 :padx 3 :pady 3)
      (ltk:grid in-posx 1 2 :padx 3 :pady 3)
      (ltk:grid in-posy 2 2 :padx 3 :pady 3)
      (ltk:grid in-velx 3 2 :padx 3 :pady 3)
      (ltk:grid in-vely 4 2 :padx 3 :pady 3)
      (ltk:grid in-size 5 2 :padx 3 :pady 3)
      (ltk:grid in-id 6 2 :padx 3 :pady 3)
      (ltk:grid label-px 1 1)
      (ltk:grid label-py 2 1)
      (ltk:grid label-vx 3 1)
      (ltk:grid label-vy 4 1)
      (ltk:grid label-sz 5 1)
      (ltk:grid label-id 6 1)
      (ltk:grid frame 1 1)
      
      ; Puts the remove body items into the window
      (ltk:listbox-append bod-list (cdr (mapcar #'id *bodies*)))
      (ltk:grid label-rm 1 1)
      (ltk:grid rm 2 1)      
      (ltk:grid bod-list 2 2)
      (ltk:grid frame2 2 1)
      
      ; Puts the save system items into the window
      (ltk:grid in-fn 1 1 :padx 3 :pady 3)
      (ltk:grid save 2 1 :padx 3 :pady 3)
      (ltk:grid load 2 2 :padx 3 :pady 3)
      (ltk:grid frame3 3 1)

      ; Puts the exit button in the window
      (ltk:grid exit 4 1 :padx 3 :pady 3)
      (ltk:mainloop)))))

{'fraction_non_alphanumeric': 0.12919265889160111, 'fraction_numerical': 0.01790073230268511, 'mean_word_length': 2.1823935558112773, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 3, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 2, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4174385', 'n_tokens_mistral': 4800, 'n_tokens_neox': 3902, 'n_words': 1256}