blob: acd386fccf7727e989ca94e96080341c116294fb [file] [log] [blame]
MG Mud User88f12472016-06-24 23:31:02 +02001(write "LPC closure parser ready...\n")
2(write "LLisp Version 0.6 [")
3;;;
4;;; automagic quoting of hardcoded functions:
5;;; each function has 2 entries in 'memory'
6;;; 0 -- the function name or equivalent
7;;; 1 -- bits regarding autoquoting
8;;; each argument for the function has two bits
9;;; 0 -- normal quoting
10;;; 1 -- program code quoting (lamda requires it)
11;;; only bit 0 or bit 1 must be set, never both (no quoting at all)
12;;; lambda needs normal quote for the first argument and special quote for 2nd
13;;; 1 0 0 1
14;;; |1| |2| -> 9 (if i have calculated it right)
15;;;
16;;; the function lambda has autoquote, @ is a non-autoquote version
17(= ([ (memory) '@) lambda)
18(= ([ (memory) lambda 1) 9)
19;;;
20;;; explicit quote of a symbol with quote
21(= ([ (memory) quote 1) 1)
22;;;
23;;; one of the most important functions needed (microcoded):
24;;; now we define a set
25(= ([ (memory) 'set) (lambda (n v) (, (= ([ (memory) n) v) n)))
26;;; and a autoquote version of set (setq)
27(set 'setq set) (= ([ (memory) 'setq 1) 1)
28;;;
29;;; some people prefer define, it quotomatically quotes its first argument
30(setq define (lambda (n v f) (, (= ([ (memory) n 1) f) (set n v) n)))
31(= ([ (memory) 'define 1) 1)
32;;;
33;;; defun for easier definition of functions
34(define defun (lambda (n a b f) (, (= ([ (memory) n 1) f)
35 (set n (@ a b)) n)) 37)
36;;;
37;;; if we like to destroy a value use undef
38(defun undef (fun) (, (= memory (m_delete (memory) fun)) fun) 1)
39;;;
40;;; an error function (internal use), notify declares the function to use
41;;; when an error message has to be printed
42(setq error raise_error)
43;;;
44;;; other important functions and function aliases
45;;; standard lisp functionality (car, cdr, cons)
46(defun car (l) (? (pointerp l)
47 (? (sizeof l) ([ l 0)
48 (error "car: empty list\n"))
49 (error "car: not a list\n")))
50(defun cdr (l) (? (pointerp l) ([.. l 1)
51 (error "cdr: not a list\n")))
52(defun cons (_car _cdr) (+ (list _car) _cdr))
53;;;
54;;; some special functionality
55(defun addhistory (file) (write_file file (implode (history) "\n")))
56(defun savehistory (file) (, (rm file) (addhistory file)))
57(defun showhistory () (, (printf "%s\n" (implode (history) "\n"))
58 "-- END OF HISTORY --"))
59;;;
60(defun showfunc () (m_indices (memory)))
61;;;
62;;; Try to autodetect mudtype
63;;;
64(set 'mudtype "")
65(defun add (var val) (+= ([ (memory) var) val))
66(add 'mudtype (? (symbol_function "getuid") "NATIVE" "COMPAT"))
67(add 'mudtype (? (function_exists "SetProp")
68 (? (== (function_exists "Set") "/std/thing/properties") "|MG"
69 "|NF")
70 (&& (== (file_size "/basic") -2)
71 (== (file_size "/complex") -2))
72 (? (== (file_size "/kernel") -2) "|TUBNEW" "|TUB")
73 (== (function_exists "query_all_v_items") "/i/item/virtual")
74 (? (function_exists "query_bodylocation_pic"
75 (, (call_other "/obj/player" "?")
76 (find_object "/obj/player")))
77 "|UNI/AVALON" "|UNI")
78 (? (function_exists "RCSId" (find_object "/obj/simul_efun")))
79 "|TAPP"
80 "|UNKNOWN/2.4.5"
81 ))
82(setq mudtype (explode mudtype "|"))
83(defun mud? (str) (sizeof (regexp ([ (memory) 'mudtype) str)))
84(printf "%s,%s" ([ ([ (memory) 'mudtype) 0) ([ ([ (memory) 'mudtype) 1))
85(write "]\n")
86;;;
87;;; load local user init
88;;;
89(? (mud? "NF|MG")
90 (setq owner (getuid (this_player)))
91 (setq owner (call_other (this_player) "query_real_name")))
92(? (mud? "MG|NF|TUB")
93 (define localinit (+ (+ "/players/" owner) "/lisp.l"))
94 (define localinit (+ (+ "/w/" owner) "/lisp.l")))
95(? (> (file_size localinit) 0)
96 (? (mud? "TUB|UNI|UNKNOWN")
97 (call_out load 0 localinit)
98 (load localinit)))
99(printf "Welcome %s, today is %s!\n" (capitalize owner) (ctime (time)))