-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathjobs.rkt
104 lines (94 loc) · 5.59 KB
/
jobs.rkt
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
#lang racket
[provide expand-job default-jobs]
[require "mystar.rkt"]
[require "utility_functions.rkt"]
[define [expand-job a-job current-loc a-map]
;[printf "Expanding: ~a~n" a-job]
[let [[newjobs [case [car a-job]
['fetch [let [[target [second a-job]][destination [third a-job]]]
[list
[list 'pathTo target]
[list 'pickUp target]
[list 'pathTo destination]
[list 'drop destination]
]]]
['pathTo [begin
[let [[path [find-path a-map current-loc [second a-job]]]]
;[showmap a-map path [make-hash]]
;[printf "Expanded ~a into ~a~n" a-job path]
[if [empty? path]
`[[pathFail ,[second a-job]]] ;If we can't path to the object, we create a fail "job"
[map [lambda [p] `[moveTo ,p]] [reverse path]] ;Otherwise return a sequence of moveTo jobs
]]]]
[else [list a-job]]
]]]
;[printf "Newjobs ~a, oldjob ~a~n" newjobs [list a-job]]
[if [equal? newjobs [list a-job]]
newjobs
[append [expand-job [car newjobs] current-loc a-map] [cdr newjobs]]] ]
]
[define [default-jobs v scene scene-get scene-set!]
;[printf "~a, ~a, ~a~n" v target colour]
[letrec [[jobqueue [second v]]
[position [first v]]]
;[printf "Jobqueue: ~a~n" jobqueue]
[if [not [empty? jobqueue]]
[letrec [[thisjob [car jobqueue]]
[target [second thisjob]]]
;[printf "Default job handler is handling: ~a~n" thisjob]
[case [car thisjob]
['moveTo
[if [equal? position [second thisjob]]
[let [[newjobs [cdr jobqueue]]]
;[set! jobs [replace-in-list [car jobs] newjob jobs]]
;[printf "Arrived! Moving to new job ~a~n" [if [empty? newjobs] "none" [car newjobs]] ]
[list [first v]
newjobs]]
;This is the creature speed
[list [map [lambda[e t] [moveTo e t 1.0]] position [second thisjob]]
jobqueue]]]
['pathFail
[printf "Failed to path to ~a~n" [second thisjob]]
[list position
[cdr jobqueue]]]
; ['pathTo
; [begin
; [printf "PathTo - position: ~a pathTo: ~a~n" position target]
; [if [equal? target position]
; [begin
; [printf "Reached pathTo goal at ~a, moving to next job~n" target]
; [list [first v] [cdr jobqueue]]]
; [letrec [[amap [build-map [scene-get 'mans] [scene-set! 'walls]]]
; [path [reverse [find-path amap [map [lambda [e] [+ 50 e]] [map round [list [first position] [third position]]]] [map [lambda [e] [+ 50]] [map round [list [first target] [third target]]]]]]]]
; [let [
; [firstStep [if [> [length path] 1]
; [second path]
; [first path]]]
; ;[waypoint [car path]]
; ]
; [printf "From: ~a to: ~a~n" [map round position] [map round target]]
; [printf "path ~a~n" path]
; [showmap amap path [make-hash]]
;
; [list [first v] [cons `[moveTo ,[list [- [first firstStep] 50] 0 [- [second firstStep] 50]]] jobqueue]]
; ]]
;
; ]]]
[else [begin
;
[printf "I don't know how to do job: ~a~n" thisjob]
v]]]]
[list [car v]
[if [not [empty? [scene-get 'jobs]]]
[letrec [[jobs [scene-get 'jobs]]
[newjob [car jobs]]]
;[printf "pending-jobs: ~a~n" jobs]
[scene-set! 'jobs [cdr jobs]]
;[printf "pending-jobs: ~a~n" [scene-get 'jobs]]
;[printf "2 Moving to new job ~a~n" newjob]
[expand-job newjob position [scene-get 'level-map]]]
'[]]
]
]
]
]