100 Days of Common Lisp

(defun band-name-gen ()
  (let ((a1 (progn (princ "Which city?")
                   (read-line)))
        (a2 (progn (princ "Which animal?")
                   (read-line))))
    (princ (concatenate 'string "Your band name: " a1 " " a2))))

(defun band-name-gen ()
  (let ((a1 (progn (princ "Which city?")
                   (read-line)))
        (a2 (progn (princ "Which animal?")
                   (read-line))))
    (princ (format nil "Your band name: ~a ~a" a1 a2))))

(defun band-name-gen ()
  (let* ((f (lambda (msg)
              (princ msg)
              (read-line)))
         (a1 (funcall f "Which city?"))
         (a2 (funcall f "Which animal?")))
    (format t "Your band name: ~a ~a" a1 a2)))

(defun band-name-gen ()
  (flet ((f (msg)
           (princ msg)
           (read-line)))
    (let ((a1 (f "Which city?"))
          (a2 (f "Which animal?")))
      (format t "Your band name: ~a ~a" a1 a2))))

(defun band-name-gen ()
  (macrolet ((f (msg)
               `(progn
                  (princ ,msg)
                  (read-line))))
    (let ((a1 (f "Which city?"))
          (a2 (f "Which animal?")))
      (format t "Your band name: ~a ~a" a1 a2))))

(defun prompt (x)
  (princ x)
  (the number (read)))

(defun tip-calc ()
  (let ((a (prompt "Bill amount: "))
        (b (prompt "Tip percent: "))
        (c (prompt "Num to split: ")))
    (format t "Your bill: ~,2F" (/ (* a (1+ (/ b 100))) c))))

(defun prompt (x)
  (princ x)
  (the string (read-line)))

(defun treasure-island ()
  (let ((a (prompt "You land on Treasure Island! Which direction do you go on the coast?")))
    (if (string/= a "left")
        "You fall into a hole."
        (if (string/= "wait"
                      (prompt "You see a river. Do you swim or wait?"))
             "You are eaten by trout."
             (let ((inp (prompt "You see a door? Which one to open?")))
               (cond
                 ((string= inp "red") "You are burned by fire.")
                 ((string= inp "blue") "You are eaten by beasts.")
                 ((string= inp "yellow") "You find the gold!")
                 (t "The world darkens around you.")))))))

(let ((a "hi"))
  (case a
    ("hi" "hello")
    ("bye" "goodbye")
    (otherwise "have a nice day")))

(let ((a 42))
  (case a
    (2 "the first prime")
    (3.14 "pi")
    (42 "the answer to everything")
    (otherwise "have a nice day")))

(cdr '(1 2 3 4))

(defun choose-list (ls)
  (nth (random (length ls)) ls))

(choose-list '(1 3 5 7 9))

(loop for i from 1 to 10 collect i)

(loop for i from 1 to 5 collect (random 101))

(let ((marks (loop for i from 1 to 5 collect (random 101))))
  (reduce '+ marks))

(loop for i from 1 to 5 :sum (random 101))

(loop for i from 1 to 5 :maximize (random 101))

(loop for i from 1 to 10
      :do (print (cond
                   ((eq (mod i 15) 0) "FizzBuzz")
                   ((eq (mod i 5) 0) "Buzz")
                   ((eq (mod i 3) 0) "Fizz")
                   (t i))))

(ql:quickload :alexandria)

(defun pass-gen (n-alpha n-num n-symb)
  (let ((alpha (mapcar #'code-char
                       ;; use a loop over 2 variables in parallel
                       (loop for i from (char-code #\a) to (char-code #\z)
                             and j from (char-code #\A) to (char-code #\Z)
                             ;; use append (instead of collect) to merge the lists
                             :append (list i j))))
        (nums (loop for i from 0 to 9 :collect (digit-char i)))
        (symbs '(#\! #\@ #\# #\$ #\% #\^ #\& #\*)))
    (flet ((sel (ls)
             (nth (random (length ls)) ls)))
      (concatenate 'string (alexandria:shuffle
       (append
        (loop repeat n-alpha :collect (sel alpha))
        (loop repeat n-num :collect (sel nums))
        (loop repeat n-symb :collect (sel symbs))))))))

(loop for i from 1 to 10 :collect (+ i 1) :do (print i))

(defvar b (make-array 10 :element-type 'integer))

;; lets initialize it with some elements
(loop for i from 0 below (length b) :do (setf (aref b i) (random 10)))

;; now, lets set some elements to 0, while also counting this phenomenon
(loop for i from 0 below (length b)
      :if (< (aref b i) 5)
      :count (setf (aref b i) 0))

(defun hangman ()
  (let* ((num_lives 7)
         (word "super") ; use a word gen here
         (mask (make-array (length word) :element-type 'bit)))
    (flet ((prompt ()
             (princ "Word: ")
             (loop for i across word
                   for j across mask
                   do (princ (if (eq j 0) "_" i))))
           (guess (val)
             (loop :for i from 0 below (length word)
                   :if (eq (aref word i) val)
                   :count (setf (aref mask i) 1))))
      (loop :while (> num_lives 0)
       :do
        (prompt)
        (format t "~% Num lives: ~a, Next guess?" num_lives)
        (if (eq 0 (guess (char (read-line) 0)))
            (decf num_lives))
        (if (every (lambda (x) (eq x 1)) mask)
            (progn
              (princ "You win")
              (return))))
      (princ "You lose!"))))

(defun f1 (a b c)
  (format t "~a ~a ~a~%" a b c))

(defun f2 (a &rest o)
  (format t "~a ~a~%" a o))

(defun f3 (a &optional o)
  (format t "~a ~a~%" a o))

(defun f4 (a &optional (b 10) (c 20))
  (format t "~a ~a ~a~%" a b c))

(defun f5 (a &key (b 10) c)
  (format t "~a ~a ~a~%" a b c))

;; assumes ascii alphabet only
(defun rotate (ch n)
  (let ((ca (char-code #\a))
        (cz (char-code #\z))
        (cA (char-code #\A))
        (cZ (char-code #\Z))
        (curr (char-code ch)))
    (flet ((run (base)
             (let* ((off (- curr base))
                    (newoff (mod (+ (+ off n) 26) 26))
                    (new (+ base newoff)))
               (code-char new))))
      (cond
        ((and (>= curr ca) (<= curr cz)) (run ca))
        ((and (>= curr da) (<= curr dz)) (run da))
        (t ch)))))

(defun caesar-cipher (msg &key (op :encode) (delta 13))
  (the (member :encode :decode) op)
  (coerce (loop for i across msg
                collect (rotate i (if (eq op :encode)
                                      delta
                                      (* -1 delta))))
                'string))

(defpackage :main
  (:use :cl
   :array-operations
   :cl-cairo2
   :lparallel))

(in-package :main)

(defparameter *w* 1000)
(defparameter *h* 1000)

(defvar grid (make-array (list *w* *h*) :element-type 'integer :initial-element 0))

;; unoptimized version
(defun calc-fractal-1 (i j)
  (let ((x0 (+ -2 (* (/ i *w*) 2.47)))
        (y0 (+ -1.12 (* (/ j *h*) 2.24))))
    (loop with x = 0 with y = 0 with iter = 0
          while (and (< iter 1000) (<= (+ (* x x) (* y y)) 4))
          do
             (let ((xtemp (+ (- (* x x)
                                (* y y))
                             x0)))
               (setf y (+ (* 2 x y) y0))
               (setf x xtemp)
               (incf iter))
          finally (return iter))))

;; optimized version
(defun calc-fractal-2 (i j)
  (let ((x0 (+ -2 (* (/ i *w*) 2.47)))
        (y0 (+ -1.12 (* (/ j *h*) 2.24))))
    (loop with x = 0 with y = 0 with x2 = 0 with y2 = 0 with iter = 0
          while (and (<= (+ x2 y2) 4) (< iter 1000))
          do
             (setf y (+ (* 2 x y) y0))
             (setf x (+ (- x2 y2) x0))
             (setf x2 (* x x))
             (setf y2 (* y y))
             (incf iter)
          finally (return iter))))

(defun mb-calc (grid)
  (loop for i below (nrow grid) do
    (loop for j below (ncol grid) do
      (setf (aref grid i j) (calc-fractal-2 i j)))))

;(mb-calc grid)

;; control degree of parallelism
(setf *kernel* (make-kernel 16))

;; quite messy looking now
;; should abstract away with a macro
(defun mb-calc-p (grid)
  (let ((ch (make-channel)))
    (loop for i below (nrow grid) do
      (loop for j below (ncol grid) do
        ;; spawn a task for each cell of the grid
        (submit-task ch
          (lambda (i j)
            (setf (aref grid i j) (calc-fractal-2 i j)))
          i j)))
    ;; collect back the (unneeded) results to sync computation
    (loop for i below (nrow grid) do
      (loop for j below (ncol grid) do
        (receive-result ch)))))

;; use time to compare perf against the serial version
;(mb-calc-p grid)

(defun get-color (val)
  ;; normalize to 1
  (let ((nv (/ val 1000)))
    (list nv nv nv)))

(defun render-grid (grid)
  (with-png-file ("output.png" :rgb24 *w* *h*)
    (set-source-rgb 0 0 0) ;; background
    (paint)
    (loop for i from 0 below (nrow grid) do
      (loop for j from 0 below (ncol grid) do
       (apply #'set-source-rgb (get-color (aref grid i j)))
       (move-to i j)
       (line-to (+ i 1) (+ j 1))
       (stroke)))))

(render-grid grid)

#include <stdio.h>
#include <stdlib.h>
#include <time.h>

typedef struct {
  float x;
  float y;
} vec2;

typedef struct {
  vec2 pos;
  vec2 vel;
} ball;

int main () {
  ball* balls = (ball*) malloc(32000 * sizeof(ball));
  for (int i=0; i < 32000; i++) {
    balls[i].pos.x = 0;
    balls[i].pos.y = 0;
    balls[i].vel.x = 0.1;
    balls[i].vel.y = 0;
  }

  struct timespec start, end;
  clock_gettime(CLOCK_MONOTONIC, &start);

  for (int t = 0; t < 1000; t++){
    for (int i = 0; i < 32000; i++) {
      balls[i].pos.x += balls[i].vel.x;
      balls[i].pos.y += balls[i].vel.y;
    }
  }

  clock_gettime(CLOCK_MONOTONIC, &end);
  int elapsed = (end.tv_sec - start.tv_sec)*1000 + (end.tv_nsec - start.tv_nsec)/1000000;

  /* printf("Sample: %f, %f\n", balls[200].pos.x, balls[200].pos.y); */
  printf("Sample: %f, %f\n", balls[31000].pos.x, balls[31000].pos.y);
  printf("Time: %d ms\n", elapsed);
}

(declaim (optimize (speed 3) (debug 0) (safety 0)))

(defstruct ball
  (x 0.0 :type single-float)
  (y 0.0 :type single-float)
  (vx 0.1 :type single-float)
  (vy 0.0 :type single-float))

(declaim (inline update-ball))
(defun update-ball (ball)
  (incf (ball-x ball) (ball-vx ball))
  (incf (ball-y ball) (ball-vy ball)))

(defun update-balls (balls size)
  (dotimes (i size)
    (let ((ball (svref balls i)))
      (update-ball ball))))

(defun test-balls ()
  (let ((balls (make-array 32000 :initial-element (make-ball))))
    (dotimes (i 32000) (setf (aref balls i) (make-ball)))
    (time (dotimes (i 1000) (update-balls balls 32000)))
    (format t "Sample: ~a~%" (ball-x (aref balls 31000)))))

(test-balls)

(defpackage bot
  (:use :cl :sdl2))

(in-package :bot)

(defstruct table
  xmin xmax ymin ymax)

(defun draw-table (table renderer)
  (sdl2:render-draw-rect renderer (sdl2:make-rect (table-xmin table)
                                                  (table-ymin table)
                                                  (- (table-xmax table)
                                                     (table-xmin table))
                                                  (- (table-ymax table)
                                                     (table-ymin table)))))

(defvar *table* (make-table :xmin 50 :ymin 50 :xmax 600 :ymax 500))

(defstruct ball
  (x 0.0 :type single-float)
  (y 0.0 :type single-float)
  (vx 5.0 :type single-float)
  (vy 5.0 :type single-float))

(defparameter br 40)

(defun update-ball (ball table)
  (symbol-macrolet ((x (ball-x ball))
                    (y (ball-y ball))
                    (vx (ball-vx ball))
                    (vy (ball-vy ball)))
    (incf x vx)
    (incf y vy)
    (if (or (>= (+ x br) (table-xmax table)) (<= (- x br) (table-xmin table)))
        (setf vx (- vx)))
    (if (or (>= (+ y br) (table-ymax table)) (<= (- y br) (table-ymin table)))
        (setf vy (- vy)))))

(defun draw-ball (ball renderer)
  (draw-circle renderer (round (ball-x ball)) (round (ball-y ball)) br))

(defvar *ball* (make-ball :x 100.0 :y 100.0))

(defun circle-points (cx cy r)
  (loop with x = (- r 1)
        with y = 0
        with tx = 1
        with ty = 1
        with err = (- tx (* 2 r))
        while (>= x y)
        collect (list (+ cx x) (- cy y))
        collect (list (+ cx x) (+ cy y))
        collect (list (- cx x) (- cy y))
        collect (list (- cx x) (+ cy y))
        collect (list (+ cx y) (- cy x))
        collect (list (+ cx y) (+ cy x))
        collect (list (- cx y) (- cy x))
        collect (list (- cx y) (+ cy x))
        if (<= err 0)
        do (progn
             (incf y)
             (incf err ty)
             (incf ty 2))
        else do
          (progn
            (decf x)
            (incf tx 2)
            (incf err (- tx (* 2 r))))))

(defun draw-circle (renderer cx cy r)
  (let* ((pts (circle-points cx cy r))
         (spts (mapcar (lambda (x) (apply #'sdl2:make-point x)) pts)))
    (multiple-value-bind (points num) (apply #'sdl2:points* spts)
      (sdl2:render-draw-points renderer points num))))

(defun draw (renderer)
  (sdl2:set-render-draw-color renderer 0 0 0 255)
  (sdl2:render-clear renderer)
  (sdl2:set-render-draw-color renderer 255 255 255 255)
  (draw-table *table* renderer)
  (draw-ball *ball* renderer))

(defun render-loop ()
  (sdl2:with-init (:everything)
    (sdl2:with-window (win :title "Screen" :flags '(:shown))
      (sdl2:with-renderer (renderer win :flags '(:accelerated))
        (sdl2:with-event-loop (:method :poll)
          (:quit () t)
          (:idle ()
            (sleep 0.02)
            (update-ball *ball* *table*)
            (draw renderer)
            (sdl2:render-present renderer)))))))

(ql:quickload :sdl2)
(ql:quickload :sdl2-image)

(defpackage sprite
  (:use :cl))

(in-package :sprite)

(defstruct table
  xmin xmax ymin ymax)

(defun draw-table (table renderer)
  (sdl2:render-draw-rect renderer (sdl2:make-rect (table-xmin table)
                                                  (table-ymin table)
                                                  (- (table-xmax table)
                                                     (table-xmin table))
                                                  (- (table-ymax table)
                                                     (table-ymin table)))))

(defvar *table* (make-table :xmin 50 :ymin 50 :xmax 600 :ymax 500))

(defclass hero ()
  ((x :initform 300 :accessor x)
   (y :initform 300 :accessor y)
   (ss :initarg :ss :accessor ss)
   (tick :initform 0 :accessor tick)
   (animspeed :initform 4 :accessor animspeed)
   (mode :initform 0 :accessor mode) ;; 0 - for idle, 2 - for walking
   (dir :initform 'right :accessor dir)))

(defun update-hero (h)
  (incf (tick h))
  (if (> (tick h) (* 9 (animspeed h)))
    (setf (tick h) 0)))

(defun draw-hero (h renderer)
  (with-slots (ss x y tick animspeed mode dir) h
    (let* ((num (floor (/ tick animspeed)))
           (xoff (* 32 num))
           (yoff (* 32 mode)))
      (sdl2:render-copy-ex renderer ss
                        :source-rect (sdl2:make-rect xoff yoff 32 32)
                        :dest-rect (sdl2:make-rect x y 128 128)
                        :flip (if (eq dir 'left)
                                  '(:horizontal)
                                  '(:none))))))

(defun draw (renderer hero)
  (sdl2:set-render-draw-color renderer 0 0 0 255)
  (sdl2:render-clear renderer)
  (sdl2:set-render-draw-color renderer 255 255 255 255)
  (draw-hero hero renderer)
  (draw-table *table* renderer))

(defun render-loop ()
  (sdl2:with-init (:everything)
    (sdl2:with-window (win :title "Screen" :flags '(:shown))
      (sdl2:with-renderer (renderer win :flags '(:accelerated))
        (let* ((surf (sdl2-image:load-png-rw "rogue.png"))
               (ss (sdl2:create-texture-from-surface renderer surf))
               (h (make-instance 'hero :ss ss)))
          (sdl2:free-surface surf)
          (sdl2:with-event-loop (:method :poll)
            (:quit () t)
            (:keydown (:keysym keysym)
             (when (sdl2:scancode= (sdl2:scancode-value keysym) :scancode-escape)
               (sdl2:push-event :quit))
             (when (sdl2:scancode= (sdl2:scancode-value keysym) :scancode-left)
               (decf (x h) 5)
               (setf (mode h) 2)
               (setf (dir h) 'left))
             (when (sdl2:scancode= (sdl2:scancode-value keysym) :scancode-right)
               (incf (x h) 5)
               (setf (mode h) 2)
               (setf (dir h) 'right)))
            (:keyup (:keysym keysym)
             (when (sdl2:scancode= (sdl2:scancode-value keysym) :scancode-left)
               (setf (mode h) 0))
             (when (sdl2:scancode= (sdl2:scancode-value keysym) :scancode-right)
               (setf (mode h) 0)))
            (:idle ()
                   (sleep 0.05)
                   (update-hero h)
                   (draw renderer h)
                   (sdl2:render-present renderer))))))))

(ql:quickload :filesystem-utils)
(ql:quickload :cl-string-match)
(ql:quickload :curly)

(defpackage cu-find
  (:use :cl :org.shirakumo.filesystem-utils))

(in-package cu-find)

(curly:enable-curly-syntax)

(defun process-entry (path str)
  (when path
    (if (sm:string-contains-brute str path)
      (format t "~a~%" path))))

(defun cu-find (match &optional (dir "."))
  (format t "Finding ~a in dir ~a~%" match dir)  
  (map-directory [process-entry * match]
                 (car (directory dir)) :type t :recursive t))

wget https://www.chandergovind.org/blog/100-days-of-CL/bundles/cl-grep.git
git clone ./cl-grep.git
# repo is now availabe in the folder cl-grep

(setf log-on t)

(defmacro logm (&rest args)
  (if log-on
    `(format t ,@args)))

(declaim (inline logf))
(defun logf (&rest args)
  (if log-on
     (apply #'format t args)))

(defun my-func ()
  (logf "my-func start")
  (+ 2 3)
  (logf "my-func ends"))