Arc Forumnew | comments | leaders | submitlogin
2 points by sacado 6118 days ago | link | parent

Well, ok, I'll deliver it, today or tomorrow, but I have to clean it a little. A few things are written in French & must be translated and a few others are security issues, I have to hide them.


2 points by almkglor 6118 days ago | link

Good ^^ I'll be making a toy that I'll smuggle into the office to handle the office gossip, just so I can also say I've used Arc at the office ^^

-----

3 points by almkglor 6118 days ago | link

toy's done, now all I have to do is smuggle it into the office....

  (= *chismakspath* "arc/chismaksball")
  (ensure-dir *chismakspath*)
  (= *chismaksmax*
    (or (most idfn
         (map [coerce _ 'int]
           (keep (let rx (re "[0-9]") [re-match rx _]) (dir *chismakspath*))))
    0))
  (deftem chismistem
    parent nil
    text ""
    replies nil)
  
  (def ch-urlencode (s)
          (let code [coerce _ 'int 16]
            (tostring
              (forlen i s
                (if (some (s i)
  "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz1234567890")
                    (pr (s i))
                  (is (s i) #\space)
                    (pr "+")
                    (pr "%" (coerce (code:s i) 'string 16)))))))
  
  (defmemo chisms (i)
    (errsafe:temload 'chismistem (file-join *chismakspath* (string i))))
  
  (def chismsupdate (i)
     (w/outfile p (file-join *chismakspath* (string i))
       (write (tablist:chisms i) p)))
  
  (mac chismispage (title . body)
    `(tag (html)
       (tag (head)
          (tag (title)
            (let title ,title
              (if title
                 (pr title " - "))
              (pr "Chismaksball!"))))
       (tag (body)
         ,@body)))
  
  (defop chismis req
    (chismispage nil
      (withs
         (
           chosen (arg req "p")
           chobj (when chosen (chisms chosen)) )
        (tag (div)
          (w/bars
            (tag (b) (link "random" "chismaksball"))
            (awhen (and chobj chobj!parent)
              (link "parent" (tostring:pr "?p=" (ch-urlencode it))))))
        (tag (div)
          (if chobj
            (pr:eschtml chobj!text)
            (prn "chismaks not found!")))
        (when chobj
          (tag (div style "font-size: 60%")
            (w/bars
              (w/link
                (chismispage "sasabat pa..."
                  (tag (div)
                    (w/bars
                      (tag (b) (link "random" "chismaksball"))
                      (link "yoko na sumabat..."
                        (+ "chismis?p=" (ch-urlencode chosen)))))
                  (tag (div) (pr:eschtml chobj!text))
                  (tag (div style "font-size: 60%; font-style: bold")
                    (pr "Replying: "))
                  (arform chismissubmit
                    (tag (input type 'hidden name 'parent value chosen) nil)
                    (textarea "ch" 8 42) (br)
                    (submit)))
                (prn "reply"))
              (awhen chobj!replies
                (w/rlink (+ "chismis?p=" (ch-urlencode (random-elt it)))
                  (prn "random reply"))))))
        (arform chismissubmit
            (tag (div style "font-size: 60%; font-style: bold")
              (pr "Bagong chismaks:"))
            (textarea "ch" 8 42) (br)
            (submit)))))
  
  (def chismissubmit (req)
    (awhen (arg req "ch")
      (let num (++ *chismaksmax*)
        (awhen (arg req "parent")
          (push (string num) ((chisms it) 'replies))
          (chismsupdate it))
        (w/outfile p (file-join *chismakspath* (string num))
          (write
            (tablist:inst 'chismistem
                  'parent (arg req "parent")
                  'text it)
            p))))
    "chismaksball")
  
  (defopr chismaksball req
    (aif (dir *chismakspath*)
      (tostring:pr "chismis?p=" (ch-urlencode:random-elt it))
      "chismis"))

-----