MG Mud User | 88f1247 | 2016-06-24 23:31:02 +0200 | [diff] [blame^] | 1 | (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))) |